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:

(25%) A través del análisis de componentes principales, identifique para un modelo de 3 factores: Los ponderadores normalizados para cada factor. Las variables incluidas en cada factor.

Cargamos Datos

library(readr)
load("C:/Users/Edwin/Desktop/Ciclo II 2022/Metodos para el Analisis Economico/data_parcial_2_A_rev.RData")
library(dplyr)

Normalizacion de los datos

norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}

VARIABLES_CORRE_POSITIVAS<-select(datos_parcial_2,"X1","X2","X3","X5","X7","X8") %>% apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame() 

VARIABLES_CORRE_NEGATIVAS<-select(datos_parcial_2,"X4","X6") %>%  apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()

VARIABLES_CORRE_POSITIVAS %>% 
  bind_cols(VARIABLES_CORRE_NEGATIVAS) %>% 
  select(X1,X2,X3,X4,X5,X6,X7,X8)->datos_seguridad_normalizados
head(datos_seguridad_normalizados)

##           X1          X2        X3        X4        X5        X6         X7
## 1 0.19354839 0.000000000 0.0400000 0.8000000 0.0000000 1.0000000 0.00000000
## 2 0.22580645 0.017167382 0.5500000 0.5000000 0.4285714 0.7844130 0.09890110
## 3 0.22580645 0.077253219 0.4000000 0.5000000 0.5714286 0.8599606 0.15384615
## 4 0.16129032 0.004291845 0.3142857 0.5714286 0.1632653 0.9261954 0.36263736
## 5 0.12903226 0.021459227 0.7000000 0.2500000 0.8571429 0.5034965 0.06593407
## 6 0.09677419 0.047210300 0.1600000 0.7000000 0.3428571 0.5571726 0.25274725
##          X8
## 1 0.1582266
## 2 0.5167488
## 3 0.4679803
## 4 0.4133709
## 5 0.7339901
## 6 0.2551724

Analisis Factorial

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

Rx<-cor(datos_seguridad_normalizados)
PC<-princomp(x = datos_seguridad_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

Analisis de componentes principales con rotacion (3 factores)

library(corrplot)
library(psych)
numero_de_factores<-3
modelo_factores_rotacion<-principal(r = datos_seguridad_normalizados,
                             nfactors = numero_de_factores,
                             covar = FALSE,
                             rotate = "varimax")
modelo_factores_rotacion

## Principal Components Analysis
## Call: principal(r = datos_seguridad_normalizados, nfactors = numero_de_factores, 
##     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 
##  with the empirical chi square  21.68  with prob <  0.0029 
## 
## Fit based upon off diagonal values = 0.98

correlaciones_modelo<-variables_pca$coord
rotacion<-varimax(correlaciones_modelo[,1:numero_de_factores])
correlaciones_modelo_rotada<-rotacion$loadings

corrplot(correlaciones_modelo_rotada[,1:numero_de_factores],
         is.corr = FALSE,
         method = "square",
         addCoef.col="grey",
         number.cex = 0.75)

Ponderadores normalizados de cada factor.

library(kableExtra)
cargas<-rotacion$loadings[1:8,1:numero_de_factores]
ponderadores<-prop.table(apply(cargas^2,MARGIN = 2,sum))
t(ponderadores) %>% 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

Variable incluidas en cada factor.

contribuciones<-apply(cargas^2,MARGIN = 2,prop.table)
contribuciones %>% 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

Factor 1 (Método CRITIC)

Normalización de datos y cálculos.

#Funciones para normalizar los datos
norm_directa <- function(x){
  return((x-min(x)) / (max(x)-min(x)))
}
norm_inverza <- function(x){
  return((max(x)-x) / (max(x)-min(x)))
}

# Normalización de los datos
library(dplyr)
datos_parcial_2 %>% dplyr::select(X3,X4,X8) %>% dplyr::transmute(X3=norm_directa(X3),X4=norm_directa(X4), X8=norm_inverza(X8)) ->data_factor_1
print(data_factor_1)

## # A tibble: 108 × 3
##       X3    X4    X8
##    <dbl> <dbl> <dbl>
##  1 0.04  0.2   0.842
##  2 0.55  0.5   0.483
##  3 0.4   0.5   0.532
##  4 0.314 0.429 0.587
##  5 0.7   0.75  0.266
##  6 0.16  0.3   0.745
##  7 0.673 0.727 0.286
##  8 0.55  0.5   0.554
##  9 0.4   0.437 0.567
## 10 0.68  0.533 0.448
## # … with 98 more rows

Cálculo de las desviaciones estándar de cada variable

data_factor_1 %>% dplyr::summarise(S3=sd(X3),S4=sd(X4),S8=sd(X8))-> sd_vector
print(sd_vector)

## # A tibble: 1 × 3
##      S3    S4    S8
##   <dbl> <dbl> <dbl>
## 1 0.246 0.201 0.209

Calculo de la matriz de correlacion

cor(data_factor_1)->mat_R_F1
print(mat_R_F1)

##            X3         X4         X8
## X3  1.0000000  0.9387159 -0.9590445
## X4  0.9387159  1.0000000 -0.9958479
## X8 -0.9590445 -0.9958479  1.0000000

Calculo de los ponderadores brutos

1-mat_R_F1->sum_data
colSums(sum_data)->sum_vector
sd_vector*sum_vector->vj
print(vj)

##          S3        S4       S8
## 1 0.4975651 0.4137152 0.825551

Calculo de los ponderadores netos

vj/sum(vj)->wj
#print(wj)

print(round(wj*100,2))

##      S3    S4    S8
## 1 28.65 23.82 47.53

Factor 2 (Metodo de Entropia)

Normalizacion de los datos

datos_parcial_2 %>% dplyr::select(X1,X2,X7)->data_norm
apply(data_norm,2,prop.table)->data_norm
print(data_norm)

##                 X1           X2          X7
##   [1,] 0.007812500 0.0007073386 0.001398601
##   [2,] 0.008680556 0.0021220159 0.007692308
##   [3,] 0.008680556 0.0070733864 0.011188811
##   [4,] 0.006944444 0.0010610080 0.024475524
##   [5,] 0.006076389 0.0024756852 0.005594406
##   [6,] 0.005208333 0.0045977011 0.017482517
##   [7,] 0.009548611 0.0031830239 0.006293706
##   [8,] 0.007812500 0.0010610080 0.004195804
##   [9,] 0.008680556 0.0014146773 0.003496503
##  [10,] 0.010416667 0.0021220159 0.004195804
##  [11,] 0.011284722 0.0014146773 0.002097902
##  [12,] 0.009548611 0.0007073386 0.006293706
##  [13,] 0.010416667 0.0042440318 0.001398601
##  [14,] 0.014756944 0.0014146773 0.002797203
##  [15,] 0.008680556 0.0063660477 0.016083916
##  [16,] 0.010416667 0.0007073386 0.004895105
##  [17,] 0.007812500 0.0014146773 0.012587413
##  [18,] 0.006076389 0.0024756852 0.012587413
##  [19,] 0.006944444 0.0031830239 0.002797203
##  [20,] 0.009548611 0.0028293546 0.015384615
##  [21,] 0.010416667 0.0070733864 0.009790210
##  [22,] 0.009548611 0.0056587091 0.001398601
##  [23,] 0.009548611 0.0017683466 0.011188811
##  [24,] 0.006076389 0.0106100796 0.020979021
##  [25,] 0.006944444 0.0056587091 0.002797203
##  [26,] 0.008680556 0.0063660477 0.004895105
##  [27,] 0.010416667 0.0056587091 0.006293706
##  [28,] 0.005208333 0.0106100796 0.011188811
##  [29,] 0.008680556 0.0682581786 0.002097902
##  [30,] 0.009548611 0.0014146773 0.006993007
##  [31,] 0.008680556 0.0007073386 0.001398601
##  [32,] 0.004340278 0.0014146773 0.002797203
##  [33,] 0.011284722 0.0123784262 0.006993007
##  [34,] 0.006944444 0.0014146773 0.005594406
##  [35,] 0.006076389 0.0010610080 0.004895105
##  [36,] 0.019097222 0.0081343943 0.007692308
##  [37,] 0.008680556 0.0021220159 0.003496503
##  [38,] 0.007812500 0.0035366932 0.009090909
##  [39,] 0.007812500 0.0159151194 0.002797203
##  [40,] 0.007812500 0.0028293546 0.001398601
##  [41,] 0.009548611 0.0028293546 0.003496503
##  [42,] 0.009548611 0.0035366932 0.007692308
##  [43,] 0.005208333 0.0007073386 0.013986014
##  [44,] 0.011284722 0.0017683466 0.003496503
##  [45,] 0.006944444 0.0424403183 0.020979021
##  [46,] 0.006944444 0.0007073386 0.001398601
##  [47,] 0.008680556 0.0014146773 0.002797203
##  [48,] 0.006076389 0.0010610080 0.002097902
##  [49,] 0.008680556 0.0035366932 0.006993007
##  [50,] 0.008680556 0.0038903625 0.002797203
##  [51,] 0.006944444 0.0007073386 0.001398601
##  [52,] 0.005208333 0.0038903625 0.007692308
##  [53,] 0.012152778 0.0028293546 0.002797203
##  [54,] 0.005208333 0.0007073386 0.006293706
##  [55,] 0.013020833 0.0015915119 0.020979021
##  [56,] 0.009548611 0.0010610080 0.002097902
##  [57,] 0.005208333 0.0045977011 0.065034965
##  [58,] 0.018229167 0.0007073386 0.004195804
##  [59,] 0.009548611 0.0007073386 0.001398601
##  [60,] 0.010416667 0.0017683466 0.004895105
##  [61,] 0.006944444 0.0024756852 0.012587413
##  [62,] 0.029513889 0.0831122900 0.065034965
##  [63,] 0.007812500 0.0007073386 0.009790210
##  [64,] 0.010416667 0.0682581786 0.044055944
##  [65,] 0.006944444 0.0070733864 0.003496503
##  [66,] 0.010416667 0.0106100796 0.002097902
##  [67,] 0.008680556 0.0679045093 0.011888112
##  [68,] 0.008680556 0.0045977011 0.020979021
##  [69,] 0.010416667 0.0056587091 0.006993007
##  [70,] 0.005208333 0.0007073386 0.011188811
##  [71,] 0.010416667 0.0159151194 0.001398601
##  [72,] 0.008680556 0.0031830239 0.019580420
##  [73,] 0.008680556 0.0021220159 0.004195804
##  [74,] 0.007812500 0.0007073386 0.001398601
##  [75,] 0.011284722 0.0021220159 0.004195804
##  [76,] 0.008680556 0.0021220159 0.002097902
##  [77,] 0.008680556 0.0679045093 0.001398601
##  [78,] 0.008680556 0.0024756852 0.004195804
##  [79,] 0.008680556 0.0010610080 0.002797203
##  [80,] 0.006944444 0.0063660477 0.012587413
##  [81,] 0.007812500 0.0106100796 0.020979021
##  [82,] 0.029513889 0.0831122900 0.065034965
##  [83,] 0.006076389 0.0686118479 0.003496503
##  [84,] 0.009548611 0.0007073386 0.001398601
##  [85,] 0.008680556 0.0017683466 0.003496503
##  [86,] 0.006076389 0.0007073386 0.001398601
##  [87,] 0.005208333 0.0010610080 0.002797203
##  [88,] 0.013020833 0.0017683466 0.006293706
##  [89,] 0.008680556 0.0007073386 0.001398601
##  [90,] 0.013888889 0.0021220159 0.006993007
##  [91,] 0.007812500 0.0017683466 0.006293706
##  [92,] 0.004340278 0.0014146773 0.001398601
##  [93,] 0.003472222 0.0014146773 0.002097902
##  [94,] 0.012152778 0.0505747126 0.002797203
##  [95,] 0.007812500 0.0014146773 0.004895105
##  [96,] 0.019965278 0.0024756852 0.004895105
##  [97,] 0.008680556 0.0014146773 0.002797203
##  [98,] 0.007812500 0.0024756852 0.004895105
##  [99,] 0.009548611 0.0028293546 0.044055944
## [100,] 0.029513889 0.0831122900 0.065034965
## [101,] 0.006076389 0.0010610080 0.003496503
## [102,] 0.005208333 0.0014146773 0.002097902
## [103,] 0.010416667 0.0010610080 0.001398601
## [104,] 0.010416667 0.0056587091 0.002097902
## [105,] 0.006076389 0.0007073386 0.001398601
## [106,] 0.010416667 0.0063660477 0.012587413
## [107,] 0.002604167 0.0028293546 0.011188811
## [108,] 0.009548611 0.0021220159 0.002097902

Formula de Entropia

funcion_entropia<-function(x){
  return(x*log(x))
}
apply(data_norm,2,funcion_entropia)->data_norm_2
#data_norm_2[is.na(data_norm_2)] <- 0
print(data_norm_2)

##                 X1           X2           X7
##   [1,] -0.03790649 -0.005131035 -0.009192004
##   [2,] -0.04120373 -0.013061833 -0.037442573
##   [3,] -0.04120373 -0.035023278 -0.050269550
##   [4,] -0.03451259 -0.007266351 -0.090806195
##   [5,] -0.03100991 -0.014857176 -0.029012521
##   [6,] -0.02738279 -0.024745742 -0.070743949
##   [7,] -0.04441402 -0.018302144 -0.031897795
##   [8,] -0.03790649 -0.007266351 -0.022966449
##   [9,] -0.04120373 -0.009281491 -0.019776195
##  [10,] -0.04754529 -0.013061833 -0.022966449
##  [11,] -0.05060414 -0.009281491 -0.012937379
##  [12,] -0.04441402 -0.005131035 -0.031897795
##  [13,] -0.04754529 -0.023181927 -0.009192004
##  [14,] -0.06221589 -0.009281491 -0.016445134
##  [15,] -0.04120373 -0.032191680 -0.066425536
##  [16,] -0.04754529 -0.005131035 -0.026039606
##  [17,] -0.03790649 -0.009281491 -0.055070660
##  [18,] -0.03100991 -0.014857176 -0.055070660
##  [19,] -0.03451259 -0.018302144 -0.016445134
##  [20,] -0.04441402 -0.016601823 -0.064221343
##  [21,] -0.04754529 -0.035023278 -0.045293156
##  [22,] -0.04441402 -0.029281327 -0.009192004
##  [23,] -0.04441402 -0.011207268 -0.050269550
##  [24,] -0.03100991 -0.048232900 -0.081067811
##  [25,] -0.03451259 -0.029281327 -0.016445134
##  [26,] -0.04120373 -0.032191680 -0.026039606
##  [27,] -0.04754529 -0.029281327 -0.031897795
##  [28,] -0.02738279 -0.048232900 -0.050269550
##  [29,] -0.04120373 -0.183236215 -0.012937379
##  [30,] -0.04441402 -0.009281491 -0.034705207
##  [31,] -0.04120373 -0.005131035 -0.009192004
##  [32,] -0.02361032 -0.009281491 -0.016445134
##  [33,] -0.05060414 -0.054363574 -0.034705207
##  [34,] -0.03451259 -0.009281491 -0.029012521
##  [35,] -0.03100991 -0.007266351 -0.026039606
##  [36,] -0.07559086 -0.039139891 -0.037442573
##  [37,] -0.04120373 -0.013061833 -0.019776195
##  [38,] -0.03790649 -0.019963088 -0.042731640
##  [39,] -0.03790649 -0.065896324 -0.016445134
##  [40,] -0.03790649 -0.016601823 -0.009192004
##  [41,] -0.04441402 -0.016601823 -0.019776195
##  [42,] -0.04441402 -0.019963088 -0.037442573
##  [43,] -0.02738279 -0.005131035 -0.059716048
##  [44,] -0.05060414 -0.011207268 -0.019776195
##  [45,] -0.03451259 -0.134096826 -0.081067811
##  [46,] -0.03451259 -0.005131035 -0.009192004
##  [47,] -0.04120373 -0.009281491 -0.016445134
##  [48,] -0.03100991 -0.007266351 -0.012937379
##  [49,] -0.04120373 -0.019963088 -0.034705207
##  [50,] -0.04120373 -0.021588606 -0.016445134
##  [51,] -0.03451259 -0.005131035 -0.009192004
##  [52,] -0.02738279 -0.021588606 -0.037442573
##  [53,] -0.05359615 -0.016601823 -0.016445134
##  [54,] -0.02738279 -0.005131035 -0.031897795
##  [55,] -0.05652610 -0.010254224 -0.081067811
##  [56,] -0.04441402 -0.007266351 -0.012937379
##  [57,] -0.02738279 -0.024745742 -0.177729518
##  [58,] -0.07300293 -0.005131035 -0.022966449
##  [59,] -0.04441402 -0.005131035 -0.009192004
##  [60,] -0.04754529 -0.011207268 -0.026039606
##  [61,] -0.03451259 -0.014857176 -0.055070660
##  [62,] -0.10397431 -0.206747032 -0.177729518
##  [63,] -0.03790649 -0.005131035 -0.045293156
##  [64,] -0.04754529 -0.183236215 -0.137555654
##  [65,] -0.03451259 -0.035023278 -0.019776195
##  [66,] -0.04754529 -0.048232900 -0.012937379
##  [67,] -0.04120373 -0.182639556 -0.052690684
##  [68,] -0.04120373 -0.024745742 -0.081067811
##  [69,] -0.04754529 -0.029281327 -0.034705207
##  [70,] -0.02738279 -0.005131035 -0.050269550
##  [71,] -0.04754529 -0.065896324 -0.009192004
##  [72,] -0.04120373 -0.018302144 -0.077014200
##  [73,] -0.04120373 -0.013061833 -0.022966449
##  [74,] -0.03790649 -0.005131035 -0.009192004
##  [75,] -0.05060414 -0.013061833 -0.022966449
##  [76,] -0.04120373 -0.013061833 -0.012937379
##  [77,] -0.04120373 -0.182639556 -0.009192004
##  [78,] -0.04120373 -0.014857176 -0.022966449
##  [79,] -0.04120373 -0.007266351 -0.016445134
##  [80,] -0.03451259 -0.032191680 -0.055070660
##  [81,] -0.03790649 -0.048232900 -0.081067811
##  [82,] -0.10397431 -0.206747032 -0.177729518
##  [83,] -0.03100991 -0.183831041 -0.019776195
##  [84,] -0.04441402 -0.005131035 -0.009192004
##  [85,] -0.04120373 -0.011207268 -0.019776195
##  [86,] -0.03100991 -0.005131035 -0.009192004
##  [87,] -0.02738279 -0.007266351 -0.016445134
##  [88,] -0.05652610 -0.011207268 -0.031897795
##  [89,] -0.04120373 -0.005131035 -0.009192004
##  [90,] -0.05939814 -0.013061833 -0.034705207
##  [91,] -0.03790649 -0.011207268 -0.031897795
##  [92,] -0.02361032 -0.009281491 -0.009192004
##  [93,] -0.01966306 -0.009281491 -0.012937379
##  [94,] -0.05359615 -0.150930296 -0.016445134
##  [95,] -0.03790649 -0.009281491 -0.026039606
##  [96,] -0.07813932 -0.014857176 -0.026039606
##  [97,] -0.04120373 -0.009281491 -0.016445134
##  [98,] -0.03790649 -0.014857176 -0.026039606
##  [99,] -0.04441402 -0.016601823 -0.137555654
## [100,] -0.10397431 -0.206747032 -0.177729518
## [101,] -0.03100991 -0.007266351 -0.019776195
## [102,] -0.02738279 -0.009281491 -0.012937379
## [103,] -0.04754529 -0.007266351 -0.009192004
## [104,] -0.04754529 -0.029281327 -0.012937379
## [105,] -0.03100991 -0.005131035 -0.009192004
## [106,] -0.04754529 -0.032191680 -0.055070660
## [107,] -0.01549646 -0.016601823 -0.050269550
## [108,] -0.04441402 -0.013061833 -0.012937379

#Número de variables en el factor:
ncol(data_norm)->m
#Constante de entropía:
-1/log(m)->K
print(K)

## [1] -0.9102392

Calculo de las entropias

K*colSums(data_norm_2)->Ej
print(Ej)

##       X1       X2       X7 
## 4.180549 3.202899 3.701923

Calculo de las especificidades

1-Ej->vj
print(vj)

##        X1        X2        X7 
## -3.180549 -2.202899 -2.701923

Calculo de los ponderadores

prop.table(vj)->wj #es igual a usar vj/sum(vj)
print(wj)

##        X1        X2        X7 
## 0.3933708 0.2724549 0.3341743

Factor 3 (Metodo de Ranking)

library(magrittr)
#Vector de Jerarquías
datos_ranking_suma<-select(datos_parcial_2,"X5","X6")
names(datos_ranking_suma)<-c("X1","X2")

#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<-ponderadores_subjetivos_rank_suma(datos_ranking_suma)

#Pesos brutos
pesos_ranking_suma$w_brutos

##             X1           X2
## 1     3.000000   3.00000000
## 2   -34.500000  -0.94736842
## 3   -47.000000   0.43589744
## 4   -11.285714   1.64864865
## 5   -72.000000  -6.09090909
## 6   -27.000000  -5.10810811
## 7   -60.636364  -6.21052632
## 8   -22.000000   0.29729730
## 9    -9.500000  -1.54545455
## 10  -37.000000  -5.45070423
## 11  -42.000000  -8.68831169
## 12  -42.454545  -3.75675676
## 13  -72.000000  -4.69230769
## 14   -5.333333   1.55072464
## 15    3.000000   3.00000000
## 16  -20.529412  -2.97014925
## 17    3.000000   3.00000000
## 18  -27.000000  -4.31707317
## 19  -84.500000  -5.86075949
## 20  -57.000000  -2.66037736
## 21  -17.833333   1.34437086
## 22    3.000000   3.00000000
## 23  -15.181818   0.18309859
## 24  -13.666667   0.95918367
## 25  -47.000000  -2.26315789
## 26  -63.666667  -2.12820513
## 27    3.000000   3.00000000
## 28  -47.000000   1.73417722
## 29  -20.076923  -1.28571429
## 30    3.000000   3.00000000
## 31    3.000000   3.00000000
## 32  -72.000000  -6.09090909
## 33  -63.666667  -2.12820513
## 34  -52.555556  -3.57894737
## 35  -40.750000  -6.85915493
## 36   -9.500000   1.63013699
## 37  -30.333333  -4.89473684
## 38  -47.000000  -8.42857143
## 39    3.000000   3.00000000
## 40  -15.750000  -1.47761194
## 41  -47.000000   0.46835443
## 42  -15.181818   1.59154930
## 43  -37.000000  -2.40540541
## 44  -49.173913 -14.39130435
## 45  -27.000000  -4.89473684
## 46  -27.769231  -2.63380282
## 47  -10.333333  -0.03030303
## 48  -57.869565 -15.30985915
## 49  -24.272727   0.22222222
## 50  -37.000000  -5.45070423
## 51   -4.692308   1.55072464
## 52  -22.000000  -4.69230769
## 53    3.000000   3.00000000
## 54  -13.666667   1.66666667
## 55    3.000000   3.00000000
## 56  -17.000000  -1.68750000
## 57  -15.181818   0.18309859
## 58  -30.333333   1.50746269
## 59  -30.333333  -2.55555556
## 60  -30.333333  -7.60606061
## 61    3.000000   3.00000000
## 62  -19.222222   0.26027397
## 63  -38.666667  -3.84931507
## 64  -37.000000  -2.40540541
## 65  -30.333333  -5.51063830
## 66  -13.666667  -5.16326531
## 67  -30.333333  -4.14285714
## 68  -37.740741  -3.32183908
## 69  -24.777778  -4.57575758
## 70  -17.000000  -2.40540541
## 71  -22.000000   1.64864865
## 72  -44.826087 -13.17647059
## 73    3.000000   3.00000000
## 74   -2.000000   1.36065574
## 75  -41.444444  -8.42857143
## 76  -30.333333  -1.05405405
## 77  -30.333333  -4.14285714
## 78   -6.090909   1.73417722
## 79  -41.444444  -8.42857143
## 80  -47.000000  -0.50877193
## 81  -30.333333  -0.50877193
## 82  -17.000000  -3.15384615
## 83  -34.500000  -8.11111111
## 84    3.000000   3.00000000
## 85  -12.384615   0.10144928
## 86   -4.692308   1.52941176
## 87  -51.545455 -14.14285714
## 88   -8.111111   1.61111111
## 89  -44.058824  -6.85915493
## 90    3.000000   3.00000000
## 91  -63.666667  -4.79220779
## 92  -43.666667 -10.72549020
## 93    3.000000   3.00000000
## 94   -5.333333   1.55072464
## 95    3.000000   3.00000000
## 96  -27.434783  -7.93750000
## 97  -30.333333  -6.52380952
## 98  -27.434783  -7.93750000
## 99  -29.352941  -2.58375635
## 100 -18.428571  -1.34782609
## 101   3.000000   3.00000000
## 102 -47.000000  -5.10810811
## 103 -57.000000 -13.66666667
## 104 -58.904762 -15.05555556
## 105 -30.333333   0.36842105
## 106 -18.428571  -1.34782609
## 107 -68.428571  -3.41025641
## 108 -24.272727  -6.37500000

Pesos normalizados

pesos_ranking_suma$w_normalizados %>% round(digits = 3)

##         X1     X2
## 1   -0.001 -0.001
## 2    0.011  0.000
## 3    0.015  0.000
## 4    0.004 -0.001
## 5    0.022  0.002
## 6    0.008  0.002
## 7    0.019  0.002
## 8    0.007  0.000
## 9    0.003  0.000
## 10   0.012  0.002
## 11   0.013  0.003
## 12   0.013  0.001
## 13   0.022  0.001
## 14   0.002  0.000
## 15  -0.001 -0.001
## 16   0.006  0.001
## 17  -0.001 -0.001
## 18   0.008  0.001
## 19   0.026  0.002
## 20   0.018  0.001
## 21   0.006  0.000
## 22  -0.001 -0.001
## 23   0.005  0.000
## 24   0.004  0.000
## 25   0.015  0.001
## 26   0.020  0.001
## 27  -0.001 -0.001
## 28   0.015 -0.001
## 29   0.006  0.000
## 30  -0.001 -0.001
## 31  -0.001 -0.001
## 32   0.022  0.002
## 33   0.020  0.001
## 34   0.016  0.001
## 35   0.013  0.002
## 36   0.003 -0.001
## 37   0.009  0.002
## 38   0.015  0.003
## 39  -0.001 -0.001
## 40   0.005  0.000
## 41   0.015  0.000
## 42   0.005  0.000
## 43   0.012  0.001
## 44   0.015  0.004
## 45   0.008  0.002
## 46   0.009  0.001
## 47   0.003  0.000
## 48   0.018  0.005
## 49   0.008  0.000
## 50   0.012  0.002
## 51   0.001  0.000
## 52   0.007  0.001
## 53  -0.001 -0.001
## 54   0.004 -0.001
## 55  -0.001 -0.001
## 56   0.005  0.001
## 57   0.005  0.000
## 58   0.009  0.000
## 59   0.009  0.001
## 60   0.009  0.002
## 61  -0.001 -0.001
## 62   0.006  0.000
## 63   0.012  0.001
## 64   0.012  0.001
## 65   0.009  0.002
## 66   0.004  0.002
## 67   0.009  0.001
## 68   0.012  0.001
## 69   0.008  0.001
## 70   0.005  0.001
## 71   0.007 -0.001
## 72   0.014  0.004
## 73  -0.001 -0.001
## 74   0.001  0.000
## 75   0.013  0.003
## 76   0.009  0.000
## 77   0.009  0.001
## 78   0.002 -0.001
## 79   0.013  0.003
## 80   0.015  0.000
## 81   0.009  0.000
## 82   0.005  0.001
## 83   0.011  0.003
## 84  -0.001 -0.001
## 85   0.004  0.000
## 86   0.001  0.000
## 87   0.016  0.004
## 88   0.003 -0.001
## 89   0.014  0.002
## 90  -0.001 -0.001
## 91   0.020  0.001
## 92   0.014  0.003
## 93  -0.001 -0.001
## 94   0.002  0.000
## 95  -0.001 -0.001
## 96   0.009  0.002
## 97   0.009  0.002
## 98   0.009  0.002
## 99   0.009  0.001
## 100  0.006  0.000
## 101 -0.001 -0.001
## 102  0.015  0.002
## 103  0.018  0.004
## 104  0.018  0.005
## 105  0.009  0.000
## 106  0.006  0.000
## 107  0.021  0.001
## 108  0.008  0.002

Gráfico de los pesos normalizados.

barplot(as.matrix(pesos_ranking_suma$w_normalizados),
        main = "Ponderadores Ranking de Suma",
        ylim = c(0,1.0),col = "pink")

Clave B

Sección I. 25%

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 el archivo data_parcial_2_B.Rdata Todas los indicadores se encuentran el archivo data_parcial_2_B.Rdata Usando Análisis Factorial determine cuántos factores deberían retenerse. ¿Qué variables quedan representadas en cada factor? Determine qué pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

library(readr)
load("C:/Users/Edwin/Desktop/Ciclo II 2022/Metodos para el Analisis Economico/data_parcial_2_B_rev.RData")

library(dplyr)
library(tidyr)
norm_directa_B<-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,FERTILID=0,TASA_NAT=0,LOG_PIB=0,URBANA=0,MORTINF=0,TASA_MOR=0))->data_parcial_2_B 

 
VARIABLES_CORRE_POSITIVAS_B<-select(data_parcial_2_B,ALFABET,INC_POB,ESPVIDAF,FERTILID,TASA_NAT,LOG_PIB,URBANA) %>% apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame() 

VARIABLES_CORRE_NEGATIVAS_B<-select(data_parcial_2_B,MORTINF,TASA_MOR) %>%  apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()

VARIABLES_CORRE_POSITIVAS_B %>% 
  bind_cols(VARIABLES_CORRE_NEGATIVAS_B) %>% 
  select(ALFABET, INC_POB, ESPVIDAF, FERTILID, TASA_NAT,
          LOG_PIB, URBANA,MORTINF, TASA_MOR)->datos_desarrollo_economico_normalizados
head(datos_desarrollo_economico_normalizados)

##   ALFABET   INC_POB   ESPVIDAF  FERTILID   TASA_NAT    LOG_PIB URBANA   MORTINF
## 1    0.98 0.3068592 0.82051282 0.3418803 0.30232558 0.60885423   0.54 0.8109756
## 2    0.29 0.5595668 0.02564103 0.8424908 1.00000000 0.09867408   0.18 0.0000000
## 3    0.99 0.1191336 0.92307692 0.1794872 0.02325581 0.94458420   0.85 0.9847561
## 4    0.62 0.6317690 0.69230769 0.8144078 0.65116279 0.76022519   0.77 0.7073171
## 5    0.95 0.2888087 0.82051282 0.3418803 0.23255814 0.63309802   0.86 0.8682927
## 6    0.98 0.3068592 0.82051282 0.3894994 0.30232558 0.70597624   0.68 0.8597561
##     TASA_MOR
## 1 0.70833333
## 2 0.08333333
## 3 0.54166667
## 4 0.75000000
## 5 0.62500000
## 6 0.75000000

Matriz de Correlacion

library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_desarrollo_economico_normalizados),histogram = TRUE,pch=12)

Prueba de Bartlett

library(psych)
options(scipen = 99999)
prueba_multicolinealidad<-cortest.bartlett(datos_desarrollo_economico_normalizados)

print(prueba_multicolinealidad)

## $chisq
## [1] 1478.145
## 
## $p.value
## [1] 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001784625
## 
## $df
## [1] 36

Analisis Factorial

library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx_B<-cor(datos_desarrollo_economico_normalizados)
PC_B<-princomp(x = datos_desarrollo_economico_normalizados ,cor = TRUE,fix_sign = FALSE)
variables_pca_B<-get_pca_var(PC_B)
factoextra::get_eig(PC_B) %>% kable(caption="Resumen PCA",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("hover"))

Resumen 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

Grafico de sedimentacion

fviz_eig(PC_B,
         choice = "eigenvalue",
         barcolor = rgb(red =0.2,green = 1,blue = 0.8),
         barfill = rgb(red =1,green = 0.6,blue = 0.8),
         addlabels = TRUE, 
       )+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

Modelos de 2 factores

library(corrplot)
numero_de_factores_B<-2
modelo_factores_2rotacion_B<-principal(r = Rx_B,
                             nfactors = numero_de_factores_B,
                             covar = FALSE,
                             rotate = "varimax")
print(modelo_factores_2rotacion_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
## 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
## MORTINF   0.65  0.71 0.92 0.075 2.0
## 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

Grafico de correlaciones

#Gráfico de aglomeración de las variables en los factores

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 = "circle",
         addCoef.col="black",
         number.cex = 0.75)

Cargaa de cada dimension

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

Contribuciones

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
FERTILID	0.17	0.05
TASA_NAT	0.19	0.05
LOG_PIB	0.09	0.10
URBANA	0.04	0.15
MORTINF	0.10	0.15
TASA_MOR	0.00	0.25

Seccion II

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)

Jerarquia de suma

library(magrittr)
ranking_variables<-c(3,4,2,1)
names(ranking_variables)<-c("X1","X2","X3","X4")

#Función para generar los pesos
ponderadores_ranking_suma<-function(vector_jerarquias){
  n<-length(vector_jerarquias)
  vector_pesos_B<-n-vector_jerarquias+1
  list(w_brutos=vector_pesos_B,w_normalizados=vector_pesos_B/sum(vector_pesos_B))
}

#Aplicando la función:
pesos_ranking_B<-ponderadores_ranking_suma(ranking_variables)

#Pesos brutos
pesos_ranking_B$w_brutos

## X1 X2 X3 X4 
##  2  1  3  4

Pesos Normalizados

#Pesos normalizados
pesos_ranking_B$w_normalizados %>% round(digits = 3)

##  X1  X2  X3  X4 
## 0.2 0.1 0.3 0.4

Grafico peso normalizados (suma)

barplot(pesos_ranking_B$w_normalizados,
        main = "Ponderadores Ranking de Suma",
        ylim = c(0,0.5),col = rgb(red =1,green = 0.6 ,blue = 1))

Jerarquia reciproca

#Función para generar los pesos
ponderadores_ranking_reciproco<-function(vector_jerarquias){
  vector_pesos_reciproco<-1/vector_jerarquias
  list(w_brutos=vector_pesos_reciproco,w_normalizados=vector_pesos_reciproco/sum(vector_pesos_reciproco))
}
#Aplicando la función:
pesos_ranking_reciproco<-ponderadores_ranking_reciproco(ranking_variables)

#Pesos brutos
pesos_ranking_reciproco$w_brutos

##        X1        X2        X3        X4 
## 0.3333333 0.2500000 0.5000000 1.0000000

Pesos normalizados

pesos_ranking_reciproco$w_normalizados %>% round(digits = 3)

##   X1   X2   X3   X4 
## 0.16 0.12 0.24 0.48

Gráfico de los pesos normalizados

barplot(pesos_ranking_reciproco$w_normalizados,
        main = "Ponderadores Ranking Recíproco",
        ylim = c(0,0.6),col = rgb(red =1,green = 0.6,blue = 0.6))

Jerarquia Exponencial

#por exponencial

#Función para generar los pesos
ponderadores_ranking_exponencial<-function(vector_jerarquias,p=4){
  n<-length(vector_jerarquias)
  vector_pesos_exponencial<-(n-vector_jerarquias+1)^p
  list(w_brutos=vector_pesos_exponencial,w_normalizados=vector_pesos_exponencial/sum(vector_pesos_exponencial))
}
#Aplicando la función:
pesos_ranking_exponencial<-ponderadores_ranking_exponencial(ranking_variables)

#Pesos brutos
pesos_ranking_exponencial$w_brutos

##  X1  X2  X3  X4 
##  16   1  81 256

Pesos normalizados

pesos_ranking_exponencial$w_normalizados %>% round(digits = 3)

##    X1    X2    X3    X4 
## 0.045 0.003 0.229 0.723

Gráfico de los pesos normalizados (por default p=4)

barplot(pesos_ranking_exponencial$w_normalizados,
        main = "Ponderadores Ranking Exponencial",
        ylim = c(0,0.8),col = rgb(red =1,green = 0.6,blue = 1))

Ejercicio 2

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

Datos

library(FuzzyAHP)

# Matriz_1
datos_matriz_comparacion_experto1 = c(1,7,4,5,
                                 NA,1,6,3,
                                 NA,NA,1,2,
                                 NA,NA,NA,1)
matriz_comparacion_experto1<-matrix(datos_matriz_comparacion_experto1,
                           nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_experto1<-pairwiseComparisonMatrix(matriz_comparacion_experto1)
matriz_comparacion_experto1@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_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.0000000 7.0000000  4.0    5
## [2,] 0.1428571 1.0000000  6.0    3
## [3,] 0.2500000 0.1666667  1.0    2
## [4,] 0.2000000 0.3333333  0.5    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

Cálculo de los pesos:

pesos_normalizados_experto1 = calculateWeights(
  matriz_comparacion_experto1)
show(pesos_normalizados_experto1)

## An object of class "Weights"
## Slot "weights":
##       w_X1       w_X2       w_X3       w_X4 
## 0.60659194 0.22331004 0.09474784 0.07535018

Grafico de ponderacion

barplot(pesos_normalizados_experto1@weights,
        main = "Ponderadores por método comparación de pares",
        ylim = c(0,0.7),col = "pink")

Datos del segundo

# Matriz_2

datos_matriz_comparacion_experto2 = c(1,7,6,3,
                                 NA,1,5,2,
                                 NA,NA,1,4,
                                 NA,NA,NA,1)
matriz_comparacion_experto2<-matrix(datos_matriz_comparacion_experto2,
                           nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_experto2<-pairwiseComparisonMatrix(
  matriz_comparacion_experto2)
matriz_comparacion_experto2@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_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.0000000  7.0 6.00    3
## [2,] 0.1428571  1.0 5.00    2
## [3,] 0.1666667  0.2 1.00    4
## [4,] 0.3333333  0.5 0.25    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

Cálculo de los pesos:

pesos_normalizados_experto2 = calculateWeights(matriz_comparacion_experto2)
show(pesos_normalizados_experto2)

## An object of class "Weights"
## Slot "weights":
##       w_X1       w_X2       w_X3       w_X4 
## 0.60919010 0.19878595 0.10987399 0.08214997

Grafico segundo experto

barplot(pesos_normalizados_experto2@weights,
        main = "Ponderadores por método comparación de pares",
        ylim = c(0,0.7),col = "pink")

Datos del tercer experto

# Matriz_3
datos_matriz_comparacion_experto3 = c(1,7,5,4,
                                 NA,1,3,2,
                                 NA,NA,1,6,
                                 NA,NA,NA,1)
matriz_comparacion_experto3<-matrix(datos_matriz_comparacion_experto3,
                           nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_experto3<-pairwiseComparisonMatrix(
  matriz_comparacion_experto3)
matriz_comparacion_experto3@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_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.0000000 7.0000000 5.0000000    4
## [2,] 0.1428571 1.0000000 3.0000000    2
## [3,] 0.2000000 0.3333333 1.0000000    6
## [4,] 0.2500000 0.5000000 0.1666667    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

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

## An object of class "Weights"
## Slot "weights":
##       w_X1       w_X2       w_X3       w_X4 
## 0.61676222 0.17252382 0.14259384 0.06812013

barplot(pesos_normalizados_experto3@weights,
        main = "Ponderadores por método comparación de pares",
        ylim = c(0,0.7),col = "pink")

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

Pesos totales normalizado y su promedio normalizado

library(kableExtra)
validez_opinion_expertos <-1/3

pesos_totales_claveB<-(pesos_normalizados_experto1@weights+
                       pesos_normalizados_experto2@weights+
                       pesos_normalizados_experto3@weights)

promedio_total_claveB<-validez_opinion_expertos*pesos_totales_claveB
show(promedio_total_claveB)

##       w_X1       w_X2       w_X3       w_X4 
## 0.61084809 0.19820660 0.11573855 0.07520676

sum(promedio_total_claveB)

## [1] 1

2.2) Si el experto 1 se pondera con 0.25, el experto 2 con 0.35 y el experto 3 con 0.40.

Ponderaciones de distintos pesos normalizada.

opinion_pesos_distintas<-(pesos_normalizados_experto1@weights*0.25)+
                         (pesos_normalizados_experto2@weights*0.35)+
                         (pesos_normalizados_experto3@weights*0.40)

show(opinion_pesos_distintas)

##       w_X1       w_X2       w_X3       w_X4 
## 0.61156941 0.19441212 0.11918039 0.07483808

sum(opinion_pesos_distintas)

## [1] 1

Practica unidad 2

Teresa Carolina Granados Palacios

2022-10-25

Clave A

Normalizacion de los datos

Analisis Factorial

Analisis de componentes principales con rotacion (3 factores)

Ponderadores normalizados de cada factor.

Variable incluidas en cada factor.

Factor 1 (Método CRITIC)

Normalización de datos y cálculos.

Cálculo de las desviaciones estándar de cada variable

Calculo de la matriz de correlacion

Calculo de los ponderadores brutos

Calculo de los ponderadores netos

Factor 2 (Metodo de Entropia)

Normalizacion de los datos

Formula de Entropia

Calculo de las entropias

Calculo de las especificidades

Calculo de los ponderadores

Factor 3 (Metodo de Ranking)

Pesos normalizados

Gráfico de los pesos normalizados.

Clave B

Sección I. 25%

Matriz de Correlacion

Prueba de Bartlett

Analisis Factorial

Grafico de sedimentacion

Modelos de 2 factores

Grafico de correlaciones

Cargaa de cada dimension

Contribuciones

Seccion II

Ejercicio 1

Jerarquia de suma

Pesos Normalizados

Grafico peso normalizados (suma)

Jerarquia reciproca

Pesos normalizados

Gráfico de los pesos normalizados

Jerarquia Exponencial

Pesos normalizados

Gráfico de los pesos normalizados (por default p=4)

Ejercicio 2

Cálculo de los pesos:

Grafico de ponderacion

Datos del segundo

Cálculo de los pesos:

Grafico segundo experto

Datos del tercer experto

Pesos totales normalizado y su promedio normalizado

Ponderaciones de distintos pesos normalizada.