Ejercicios para segundo examen de Métodos
Kevin Adonay Lemus Perez Carnet: LP16027
2022-10-26
Solucion Ejercicio clave A
carga de datos
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(kableExtra)##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rowsload("E:/data_parcial_2_A.RData")
head(datos_parcial_2)## # A tibble: 6 × 10
## ID Municipio X1 X2 X3 X4 X5 X6 X7 X8
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 ATIQUIZAYA 9 2 20 20 0 0 2 56.4
## 2 2 EL CARMEN 10 6 62.5 50 37.5 3.95 11 147.
## 3 3 ALEGRIA 10 20 50 50 50 2.56 16 135
## 4 4 SAN JULIAN 8 3 42.9 42.9 14.3 1.35 35 121.
## 5 5 TEJUTLA 7 7 75 75 75 9.09 8 202.
## 6 6 PASAQUINA 6 13 30 30 30 8.11 25 811. (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.
Normalización de los datos
library(dplyr)
options(scipen = 99999)
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
datos_parcial_2 %>%
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
datos_parcial_2 %>%
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_parcial_2_normalizados
head(datos_parcial_2_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.2551724Matriz de Correlación & Pruebas de Barlett y KMO
#Matriz de correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_parcial_2_normalizados),histogram = TRUE,pch=12)## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
Solución Rotada
library(psych)
data<-datos_parcial_2[,-2]
modelo_3<-principal(r = data,nfactors = 3,covar = FALSE,rotate = "varimax")
modelo_3$loadings##
## Loadings:
## RC1 RC2 RC3
## ID 0.973
## X1 -0.152 0.798
## X2 0.831 0.104
## X3 0.930 -0.103
## X4 0.939 0.105
## X5 0.804 -0.233
## X6 0.696
## X7 0.834
## X8 0.948
##
## RC1 RC2 RC3
## SS loadings 3.813 2.053 1.049
## Proportion Var 0.424 0.228 0.117
## Cumulative Var 0.424 0.652 0.7682. (25%) Para el factor 1, utilice el método CRITIC para obtener los ponderadores normalizados para cada variable.
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(X1,X3,X4,X5,X6,X8) %>% dplyr::transmute(X1=norm_inverza(X1),X3=norm_directa(X3),X4=norm_directa(X4),X5=norm_directa(X5),X6=norm_directa(X6), X8=norm_directa(X8)) ->data_factor_1
print(data_factor_1)## # A tibble: 108 × 6
## X1 X3 X4 X5 X6 X8
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.806 0.04 0.2 0 0 0.158
## 2 0.774 0.55 0.5 0.429 0.216 0.517
## 3 0.774 0.4 0.5 0.571 0.140 0.468
## 4 0.839 0.314 0.429 0.163 0.0738 0.413
## 5 0.871 0.7 0.75 0.857 0.497 0.734
## 6 0.903 0.16 0.3 0.343 0.443 0.255
## 7 0.742 0.673 0.727 0.727 0.503 0.714
## 8 0.806 0.55 0.5 0.286 0.148 0.446
## 9 0.774 0.4 0.437 0.143 0.248 0.433
## 10 0.710 0.68 0.533 0.457 0.462 0.552
## # … with 98 more rows#Cálculo de las desviaciones estándar de cada variable
data_factor_1 %>% dplyr::summarise(S6=sd(X1),S3=sd(X3),S4=sd(X4), S5=sd(X5),S6=sd(X6),S8=sd(X8))-> sd_vector
print(sd_vector)## # A tibble: 1 × 5
## S6 S3 S4 S5 S8
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.250 0.246 0.201 0.245 0.209#Cálculo de la matriz de correlación
cor(data_factor_1)->mat_R_F1
print(mat_R_F1)## X1 X3 X4 X5 X6 X8
## X1 1.00000000 0.1997783 0.1821490 0.1648052 0.08668403 0.1867325
## X3 0.19977834 1.0000000 0.9387159 0.5994166 0.50608068 0.9590445
## X4 0.18214897 0.9387159 1.0000000 0.6100016 0.48172812 0.9958479
## X5 0.16480518 0.5994166 0.6100016 1.0000000 0.69377337 0.6191349
## X6 0.08668403 0.5060807 0.4817281 0.6937734 1.00000000 0.4913386
## X8 0.18673249 0.9590445 0.9958479 0.6191349 0.49133862 1.0000000#Cálculo de los ponderadores brutos
1-mat_R_F1->sum_data
colSums(sum_data)->sum_vector
sd_vector*sum_vector->vj
print(vj)## S6 S3 S4 S5 S8
## 1 1.04679 0.442555 0.3603048 0.567286 0.5720347#Cálculo de los ponderadores netos
vj/sum(vj)->wj
print(wj)## S6 S3 S4 S5 S8
## 1 0.3502177 0.1480627 0.1205448 0.1897931 0.1913818#Ponderadores:
print(round(wj*100,2))## S6 S3 S4 S5 S8
## 1 35.02 14.81 12.05 18.98 19.143. (25%) Para el factor 2, utilice el método de Entropía para obtener los ponderadores normalizados para cada variable.
Método de Entropía
#Normalización de los datos
datos_parcial_2 %>% dplyr::select(X1,X2,X3,X7)->data_norm
apply(data_norm,2,prop.table)->data_norm
print(data_norm)## X1 X2 X3 X7
## [1,] 0.007812500 0.0007073386 0.003187702 0.001398601
## [2,] 0.008680556 0.0021220159 0.009961569 0.007692308
## [3,] 0.008680556 0.0070733864 0.007969255 0.011188811
## [4,] 0.006944444 0.0010610080 0.006830790 0.024475524
## [5,] 0.006076389 0.0024756852 0.011953883 0.005594406
## [6,] 0.005208333 0.0045977011 0.004781553 0.017482517
## [7,] 0.009548611 0.0031830239 0.011591644 0.006293706
## [8,] 0.007812500 0.0010610080 0.009961569 0.004195804
## [9,] 0.008680556 0.0014146773 0.007969255 0.003496503
## [10,] 0.010416667 0.0021220159 0.011688241 0.004195804
## [11,] 0.011284722 0.0014146773 0.014344660 0.002097902
## [12,] 0.009548611 0.0007073386 0.010142689 0.006293706
## [13,] 0.010416667 0.0042440318 0.013946197 0.001398601
## [14,] 0.014756944 0.0014146773 0.003984628 0.002797203
## [15,] 0.008680556 0.0063660477 0.007969255 0.016083916
## [16,] 0.010416667 0.0007073386 0.011250713 0.004895105
## [17,] 0.007812500 0.0014146773 0.011953883 0.012587413
## [18,] 0.006076389 0.0024756852 0.009563106 0.012587413
## [19,] 0.006944444 0.0031830239 0.013946197 0.002797203
## [20,] 0.009548611 0.0028293546 0.012750809 0.015384615
## [21,] 0.010416667 0.0070733864 0.007305151 0.009790210
## [22,] 0.009548611 0.0056587091 0.006375404 0.001398601
## [23,] 0.009548611 0.0017683466 0.005795822 0.011188811
## [24,] 0.006076389 0.0106100796 0.005312837 0.020979021
## [25,] 0.006944444 0.0056587091 0.009961569 0.002797203
## [26,] 0.008680556 0.0063660477 0.013282092 0.004895105
## [27,] 0.010416667 0.0056587091 0.006375404 0.006293706
## [28,] 0.005208333 0.0106100796 0.007969255 0.011188811
## [29,] 0.008680556 0.0682581786 0.007356236 0.002097902
## [30,] 0.009548611 0.0014146773 0.003984628 0.006993007
## [31,] 0.008680556 0.0007073386 0.002656418 0.001398601
## [32,] 0.004340278 0.0014146773 0.011953883 0.002797203
## [33,] 0.011284722 0.0123784262 0.013282092 0.006993007
## [34,] 0.006944444 0.0014146773 0.012396619 0.005594406
## [35,] 0.006076389 0.0010610080 0.011953883 0.004895105
## [36,] 0.019097222 0.0081343943 0.005976942 0.007692308
## [37,] 0.008680556 0.0021220159 0.010625674 0.003496503
## [38,] 0.007812500 0.0035366932 0.010957726 0.009090909
## [39,] 0.007812500 0.0159151194 0.003984628 0.002797203
## [40,] 0.007812500 0.0028293546 0.002988471 0.001398601
## [41,] 0.009548611 0.0028293546 0.011953883 0.003496503
## [42,] 0.009548611 0.0035366932 0.010142689 0.007692308
## [43,] 0.005208333 0.0007073386 0.009563106 0.013986014
## [44,] 0.011284722 0.0017683466 0.011780638 0.003496503
## [45,] 0.006944444 0.0424403183 0.007969255 0.020979021
## [46,] 0.006944444 0.0007073386 0.011034354 0.001398601
## [47,] 0.008680556 0.0014146773 0.007437972 0.002797203
## [48,] 0.006076389 0.0010610080 0.011780638 0.002097902
## [49,] 0.008680556 0.0035366932 0.005795822 0.006993007
## [50,] 0.008680556 0.0038903625 0.009563106 0.002797203
## [51,] 0.006944444 0.0007073386 0.007356236 0.001398601
## [52,] 0.005208333 0.0038903625 0.009961569 0.007692308
## [53,] 0.012152778 0.0028293546 0.007969255 0.002797203
## [54,] 0.005208333 0.0007073386 0.007969255 0.006293706
## [55,] 0.013020833 0.0015915119 0.007969255 0.020979021
## [56,] 0.009548611 0.0010610080 0.007969255 0.002097902
## [57,] 0.005208333 0.0045977011 0.004346867 0.065034965
## [58,] 0.018229167 0.0007073386 0.005312837 0.004195804
## [59,] 0.009548611 0.0007073386 0.014610302 0.001398601
## [60,] 0.010416667 0.0017683466 0.007589767 0.004895105
## [61,] 0.006944444 0.0024756852 0.005312837 0.012587413
## [62,] 0.029513889 0.0831122900 0.008854728 0.065034965
## [63,] 0.007812500 0.0007073386 0.010625674 0.009790210
## [64,] 0.010416667 0.0682581786 0.011156958 0.044055944
## [65,] 0.006944444 0.0070733864 0.009297465 0.003496503
## [66,] 0.010416667 0.0106100796 0.007305151 0.002097902
## [67,] 0.008680556 0.0679045093 0.009563106 0.011888112
## [68,] 0.008680556 0.0045977011 0.010035359 0.020979021
## [69,] 0.010416667 0.0056587091 0.006198310 0.006993007
## [70,] 0.005208333 0.0007073386 0.012750809 0.011188811
## [71,] 0.010416667 0.0159151194 0.005976942 0.001398601
## [72,] 0.008680556 0.0031830239 0.012473617 0.019580420
## [73,] 0.008680556 0.0021220159 0.005312837 0.004195804
## [74,] 0.007812500 0.0007073386 0.008766181 0.001398601
## [75,] 0.011284722 0.0021220159 0.014167565 0.004195804
## [76,] 0.008680556 0.0021220159 0.015938511 0.002097902
## [77,] 0.008680556 0.0679045093 0.010625674 0.001398601
## [78,] 0.008680556 0.0024756852 0.004346867 0.004195804
## [79,] 0.008680556 0.0010610080 0.012396619 0.002797203
## [80,] 0.006944444 0.0063660477 0.007969255 0.012587413
## [81,] 0.007812500 0.0106100796 0.013282092 0.020979021
## [82,] 0.029513889 0.0831122900 0.004781553 0.065034965
## [83,] 0.006076389 0.0686118479 0.013946197 0.003496503
## [84,] 0.009548611 0.0007073386 0.015938511 0.001398601
## [85,] 0.008680556 0.0017683466 0.008582275 0.003496503
## [86,] 0.006076389 0.0007073386 0.006130196 0.001398601
## [87,] 0.005208333 0.0010610080 0.015214033 0.002797203
## [88,] 0.013020833 0.0017683466 0.003541891 0.006293706
## [89,] 0.008680556 0.0007073386 0.008438035 0.001398601
## [90,] 0.013888889 0.0021220159 0.002656418 0.006993007
## [91,] 0.007812500 0.0017683466 0.012396619 0.006293706
## [92,] 0.004340278 0.0014146773 0.012750809 0.001398601
## [93,] 0.003472222 0.0014146773 0.005312837 0.002097902
## [94,] 0.012152778 0.0505747126 0.011953883 0.002797203
## [95,] 0.007812500 0.0014146773 0.007969255 0.004895105
## [96,] 0.019965278 0.0024756852 0.008315745 0.004895105
## [97,] 0.008680556 0.0014146773 0.009740201 0.002797203
## [98,] 0.007812500 0.0024756852 0.011087660 0.004895105
## [99,] 0.009548611 0.0028293546 0.008906815 0.044055944
## [100,] 0.029513889 0.0831122900 0.007969255 0.065034965
## [101,] 0.006076389 0.0010610080 0.015938511 0.003496503
## [102,] 0.005208333 0.0014146773 0.011953883 0.002097902
## [103,] 0.010416667 0.0010610080 0.011156958 0.001398601
## [104,] 0.010416667 0.0056587091 0.012143627 0.002097902
## [105,] 0.006076389 0.0007073386 0.010625674 0.001398601
## [106,] 0.010416667 0.0063660477 0.007969255 0.012587413
## [107,] 0.002604167 0.0028293546 0.011384651 0.011188811
## [108,] 0.009548611 0.0021220159 0.006520300 0.002097902#Fórmula de entropía
entropy<-function(x){
return(x*log(x))
}
apply(data_norm,2,entropy)->data_norm_2
print(data_norm_2)## X1 X2 X3 X7
## [1,] -0.03790649 -0.005131035 -0.01832436 -0.009192004
## [2,] -0.04120373 -0.013061833 -0.04591308 -0.037442573
## [3,] -0.04120373 -0.035023278 -0.03850875 -0.050269550
## [4,] -0.03451259 -0.007266351 -0.03406047 -0.090806195
## [5,] -0.03100991 -0.014857176 -0.05291624 -0.029012521
## [6,] -0.02738279 -0.024745742 -0.02554779 -0.070743949
## [7,] -0.04441402 -0.018302144 -0.05166942 -0.031897795
## [8,] -0.03790649 -0.007266351 -0.04591308 -0.022966449
## [9,] -0.04120373 -0.009281491 -0.03850875 -0.019776195
## [10,] -0.04754529 -0.013061833 -0.05200300 -0.022966449
## [11,] -0.05060414 -0.009281491 -0.06088415 -0.012937379
## [12,] -0.04441402 -0.005131035 -0.04656511 -0.031897795
## [13,] -0.04754529 -0.023181927 -0.05958580 -0.009192004
## [14,] -0.06221589 -0.009281491 -0.02201631 -0.016445134
## [15,] -0.04120373 -0.032191680 -0.03850875 -0.066425536
## [16,] -0.04754529 -0.005131035 -0.05048559 -0.026039606
## [17,] -0.03790649 -0.009281491 -0.05291624 -0.055070660
## [18,] -0.03100991 -0.014857176 -0.04446694 -0.055070660
## [19,] -0.03451259 -0.018302144 -0.05958580 -0.016445134
## [20,] -0.04441402 -0.016601823 -0.05562107 -0.064221343
## [21,] -0.04754529 -0.035023278 -0.03593532 -0.045293156
## [22,] -0.04441402 -0.029281327 -0.03222963 -0.009192004
## [23,] -0.04441402 -0.011207268 -0.02985207 -0.050269550
## [24,] -0.03100991 -0.048232900 -0.02782667 -0.081067811
## [25,] -0.03451259 -0.029281327 -0.04591308 -0.016445134
## [26,] -0.04120373 -0.032191680 -0.05739642 -0.026039606
## [27,] -0.04754529 -0.029281327 -0.03222963 -0.031897795
## [28,] -0.02738279 -0.048232900 -0.03850875 -0.050269550
## [29,] -0.04120373 -0.183236215 -0.03613535 -0.012937379
## [30,] -0.04441402 -0.009281491 -0.02201631 -0.034705207
## [31,] -0.04120373 -0.005131035 -0.01575462 -0.009192004
## [32,] -0.02361032 -0.009281491 -0.05291624 -0.016445134
## [33,] -0.05060414 -0.054363574 -0.05739642 -0.034705207
## [34,] -0.03451259 -0.009281491 -0.05442527 -0.029012521
## [35,] -0.03100991 -0.007266351 -0.05291624 -0.026039606
## [36,] -0.07559086 -0.039139891 -0.03060102 -0.037442573
## [37,] -0.04120373 -0.013061833 -0.04828819 -0.019776195
## [38,] -0.03790649 -0.019963088 -0.04946000 -0.042731640
## [39,] -0.03790649 -0.065896324 -0.02201631 -0.016445134
## [40,] -0.03790649 -0.016601823 -0.01737196 -0.009192004
## [41,] -0.04441402 -0.016601823 -0.05291624 -0.019776195
## [42,] -0.04441402 -0.019963088 -0.04656511 -0.037442573
## [43,] -0.02738279 -0.005131035 -0.04446694 -0.059716048
## [44,] -0.05060414 -0.011207268 -0.05232132 -0.019776195
## [45,] -0.03451259 -0.134096826 -0.03850875 -0.081067811
## [46,] -0.03451259 -0.005131035 -0.04972898 -0.009192004
## [47,] -0.04120373 -0.009281491 -0.03645467 -0.016445134
## [48,] -0.03100991 -0.007266351 -0.05232132 -0.012937379
## [49,] -0.04120373 -0.019963088 -0.02985207 -0.034705207
## [50,] -0.04120373 -0.021588606 -0.04446694 -0.016445134
## [51,] -0.03451259 -0.005131035 -0.03613535 -0.009192004
## [52,] -0.02738279 -0.021588606 -0.04591308 -0.037442573
## [53,] -0.05359615 -0.016601823 -0.03850875 -0.016445134
## [54,] -0.02738279 -0.005131035 -0.03850875 -0.031897795
## [55,] -0.05652610 -0.010254224 -0.03850875 -0.081067811
## [56,] -0.04441402 -0.007266351 -0.03850875 -0.012937379
## [57,] -0.02738279 -0.024745742 -0.02363956 -0.177729518
## [58,] -0.07300293 -0.005131035 -0.02782667 -0.022966449
## [59,] -0.04441402 -0.005131035 -0.06174355 -0.009192004
## [60,] -0.04754529 -0.011207268 -0.03704531 -0.026039606
## [61,] -0.03451259 -0.014857176 -0.02782667 -0.055070660
## [62,] -0.10397431 -0.206747032 -0.04185456 -0.177729518
## [63,] -0.03790649 -0.005131035 -0.04828819 -0.045293156
## [64,] -0.04754529 -0.183236215 -0.05015824 -0.137555654
## [65,] -0.03451259 -0.035023278 -0.04349367 -0.019776195
## [66,] -0.04754529 -0.048232900 -0.03593532 -0.012937379
## [67,] -0.04120373 -0.182639556 -0.04446694 -0.052690684
## [68,] -0.04120373 -0.024745742 -0.04617911 -0.081067811
## [69,] -0.04754529 -0.029281327 -0.03150898 -0.034705207
## [70,] -0.02738279 -0.005131035 -0.05562107 -0.050269550
## [71,] -0.04754529 -0.065896324 -0.03060102 -0.009192004
## [72,] -0.04120373 -0.018302144 -0.05468608 -0.077014200
## [73,] -0.04120373 -0.013061833 -0.02782667 -0.022966449
## [74,] -0.03790649 -0.005131035 -0.04152412 -0.009192004
## [75,] -0.05060414 -0.013061833 -0.06030849 -0.022966449
## [76,] -0.04120373 -0.013061833 -0.06596977 -0.012937379
## [77,] -0.04120373 -0.182639556 -0.04828819 -0.009192004
## [78,] -0.04120373 -0.014857176 -0.02363956 -0.022966449
## [79,] -0.04120373 -0.007266351 -0.05442527 -0.016445134
## [80,] -0.03451259 -0.032191680 -0.03850875 -0.055070660
## [81,] -0.03790649 -0.048232900 -0.05739642 -0.081067811
## [82,] -0.10397431 -0.206747032 -0.02554779 -0.177729518
## [83,] -0.03100991 -0.183831041 -0.05958580 -0.019776195
## [84,] -0.04441402 -0.005131035 -0.06596977 -0.009192004
## [85,] -0.04120373 -0.011207268 -0.04083495 -0.019776195
## [86,] -0.03100991 -0.005131035 -0.03123046 -0.009192004
## [87,] -0.02738279 -0.007266351 -0.06367890 -0.016445134
## [88,] -0.05652610 -0.011207268 -0.01998723 -0.031897795
## [89,] -0.04120373 -0.005131035 -0.04029167 -0.009192004
## [90,] -0.05939814 -0.013061833 -0.01575462 -0.034705207
## [91,] -0.03790649 -0.011207268 -0.05442527 -0.031897795
## [92,] -0.02361032 -0.009281491 -0.05562107 -0.009192004
## [93,] -0.01966306 -0.009281491 -0.02782667 -0.012937379
## [94,] -0.05359615 -0.150930296 -0.05291624 -0.016445134
## [95,] -0.03790649 -0.009281491 -0.03850875 -0.026039606
## [96,] -0.07813932 -0.014857176 -0.03982913 -0.026039606
## [97,] -0.04120373 -0.009281491 -0.04511168 -0.016445134
## [98,] -0.03790649 -0.014857176 -0.04991578 -0.026039606
## [99,] -0.04441402 -0.016601823 -0.04204853 -0.137555654
## [100,] -0.10397431 -0.206747032 -0.03850875 -0.177729518
## [101,] -0.03100991 -0.007266351 -0.06596977 -0.019776195
## [102,] -0.02738279 -0.009281491 -0.05291624 -0.012937379
## [103,] -0.04754529 -0.007266351 -0.05015824 -0.009192004
## [104,] -0.04754529 -0.029281327 -0.05356494 -0.012937379
## [105,] -0.03100991 -0.005131035 -0.04828819 -0.009192004
## [106,] -0.04754529 -0.032191680 -0.03850875 -0.055070660
## [107,] -0.01549646 -0.016601823 -0.05095188 -0.050269550
## [108,] -0.04441402 -0.013061833 -0.03281559 -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.7213475#Cálculo de las entropías
K*colSums(data_norm_2)->Ej
print(Ej)## X1 X2 X3 X7
## 3.313007 2.538238 3.330032 2.933705#Cálculo de las especificidades:
1-Ej->vj
print(vj)## X1 X2 X3 X7
## -2.313007 -1.538238 -2.330032 -1.933705#Cálculo de los ponderadores:
prop.table(vj)->wj #es igual a usar vj/sum(vj)
print(wj)## X1 X2 X3 X7
## 0.2850292 0.1895553 0.2871272 0.23828834. (25%) 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).
Metodo de Ranking
library(magrittr)
#Vector de Jerarquías
rj<-c( 2,4,5 )
names(rj)<-c("X2","X4","X5")
#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(rj)
#Pesos brutos
pesos_ranking_suma$w_brutos## X2 X4 X5
## 2 0 -1#Pesos normalizados
pesos_ranking_suma$w_normalizados %>% round(digits = 3)## X2 X4 X5
## 2 0 -1#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma$w_normalizados,
main = "Ponderadores Ranking de Suma",
ylim = c(0,0.5),col = "red")
- Jerarquía Reciproca El peso (bruto) se asigna mediante la expresión: wj=1/rj
y los pesos normalizados mediante: w¯j=wj/∑wj
library(magrittr)
#Vector de Jerarquías
rj<-c(2,4,5)
names(rj)<-c("X2","X4","X5")
#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<-ponderadores_subjetivos_rank_reciproco(rj)
#Pesos brutos
pesos_ranking_reciproco$w_brutos## X2 X4 X5
## 0.50 0.25 0.20#Pesos normalizados
pesos_ranking_reciproco$w_normalizados %>% round(digits = 3)## X2 X4 X5
## 0.526 0.263 0.211#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco$w_normalizados,
main = "Ponderadores Ranking Recíproco",
ylim = c(0,0.5),col = "green")
- Jerarquía Exponencial
El peso (bruto) se asigna mediante la expresión: wj=(n−rj+1)p
y los pesos normalizados mediante: w¯j=wj/∑wj
library(magrittr)
#Vector de Jerarquías
rj<-c(2,4,5)
names(rj)<-c("X2","X4","X5")
#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<-ponderadores_subjetivos_rank_exponencial(rj)
#Pesos brutos
pesos_ranking_exponencial$w_brutos## X2 X4 X5
## 16 0 1#Pesos normalizados
pesos_ranking_exponencial$w_normalizados %>% round(digits = 3)## X2 X4 X5
## 0.941 0.000 0.059#Gráfico de los pesos normalizados (por default p=4)
barplot(pesos_ranking_suma$w_normalizados,
main = "Ponderadores Ranking Exponencial",
ylim = c(0,0.5),col = "coral")
#Comparación de valores de "p"
par(mfrow=c(1,3))
for(p in 2:4){
pesos<-ponderadores_subjetivos_rank_exponencial(vector_jerarquias = rj,p = p)
barplot(pesos$w_normalizados,main = paste0("p=",p),ylim = c(0,0.7),col = "coral",cex.main=3,cex.axis = 3)
}
Ejercicio clave b
carga de datos
load("E:/data_parcial_2_B.RData")
head(data_parcial_2)## # A tibble: 6 × 26
## PAÍS POBLAC DENSI…¹ URBANA RELIG ESPVI…² ESPVI…³ ALFABET INC_POB MORTINF
## <chr> <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Acerbaján 7400 86 54 Musu… 75 67 98 1.4 35
## 2 Afganistán 20500 25 18 Musu… 44 45 29 2.8 168
## 3 Alemania 81200 227 85 Prot… 79 73 99 0.36 6.5
## 4 Arabia Sa… 18000 7.7 77 Musu… 70 66 62 3.2 52
## 5 Argentina 33900 12 86 Cató… 75 68 95 1.3 25.6
## 6 Armenia 3700 126 68 Orto… 75 68 98 1.4 27
## # … with 16 more variables: PIB_CAP <dbl>, REGIÓN <hvn_lbll>, CALORÍAS <dbl>,
## # SIDA <dbl>, TASA_NAT <dbl>, TASA_MOR <dbl>, TASASIDA <dbl>, LOG_PIB <dbl>,
## # LOGTSIDA <dbl>, NAC_DEF <dbl>, FERTILID <dbl>, LOG_POB <dbl>,
## # CREGRANO <dbl>, ALFABMAS <dbl>, ALFABFEM <dbl>, CLIMA <hvn_lbll>, and
## # abbreviated variable names ¹DENSIDAD, ²ESPVIDAF, ³ESPVIDAMSe 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.
1.1 Usando Análisis Factorial determine cuántos factores deberían retenerse.
SECCION I
Normalizacion de datos
library(dplyr)
library(tidyr)##
## Attaching package: 'tidyr'## The following object is masked from 'package:magrittr':
##
## extractnorm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}
## Eliminando valores nulos
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
## Seleccionando variables con correlación positiva con desarrollo de economias
data_parcial_2%>%
dplyr::select(ALFABET,INC_POB,ESPVIDAF,FERTILID,TASA_NAT,LOG_PIB,URBANA) %>%
apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->var_corr_positiva
## Seleccionando variables con correlación negativa con desarrollo de economias
data_parcial_2 %>%
dplyr::select(MORTINF,TASA_MOR) %>%
apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->var_corr_negativa
## Juntando y reordenando las variables
var_corr_positiva %>%
bind_cols(var_corr_negativa) %>%
dplyr::select(ALFABET,INC_POB,ESPVIDAF,FERTILID,TASA_NAT,LOG_PIB,URBANA,MORTINF,TASA_MOR)->data_p2_normalizados
head(data_p2_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.75000000Matriz Rx
## Matriz de correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(data_p2_normalizados),histogram = TRUE,pch=12)## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
Pruebas KMO y Barlett
#KMO
library(rela)
KMO<-paf(as.matrix(data_p2_normalizados))$KMO
print(KMO)## [1] 0.85275#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(data_p2_normalizados)## R was not square, finding R from dataprint(Barlett)## $chisq
## [1] 1478.1
##
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000017846
##
## $df
## [1] 36Como el KMO > 0.5 y el pvalue < 0.05, se tiene que puede procederse al análisis factorial porque existe multicolinealidad en los valores de la matriz de información
analisis factorial
library(FactoMineR)
library(factoextra)## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alpha## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(kableExtra)
Rx<-cor(data_p2_normalizados)
PC<-princomp(x = data_p2_normalizados,cor = TRUE,fix_sign = FALSE)
variables_pca<-get_pca_var(PC)
factoextra::get_eig(PC) %>% kable(caption="Resumen PCA",
align = "c",
digits = 2) %>%
kable_material_dark(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("hover"))| 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 |
Gráfico de sedimentación
fviz_eig(PC,
choice = "eigenvalue",
barcolor = "pink",
barfill = "blue",
addlabels = TRUE,
)+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
xlab(label = "Componentes")+
ylab(label = "Autovalores")+geom_hline(yintercept = 1)
R/ Basado en el criterio de raíz latente (que se verifica en el gréfico de sedimentación), en el criterio del autovalor mayor que 1, en el criterio que están por encima del turning point y en que ambos explican más del 70% de la varianza acumulada, se extraen los primeros 2 componentes.
1.2) ¿Qué variables quedan representadas en cada factor?
library(corrplot)## corrplot 0.92 loaded#Modelo de 2 Factores (Rotada)
numero_de_factores<-2
modelo_2_factores<-principal(r = Rx,
nfactors = numero_de_factores,
covar = FALSE,
rotate = "varimax")
print(modelo_2_factores)## Principal Components Analysis
## Call: principal(r = Rx, nfactors = numero_de_factores, 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#Gráfico de aglomeración de las variables en los factores
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 = "circle",
addCoef.col="black",
number.cex = 0.75)
En el factor 1 quedan representadas ALFABET, INC_POB, FERTILID, TASA_NAT Y LOG_PIB En el factor 2 quedan representadas ESPVIDAF, URBANA, MORTINF Y TASA_MOR
1.3) Determine que pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.
# Cargas de cada dimensión
library(kableExtra)
cargas<-rotacion$loadings[1:6,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_dark(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Dim.1 | Dim.2 |
|---|---|
| 0.72 | 0.28 |
# Contribuciones
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_dark(html_font = "sans-serif") %>%
kable_styling(bootstrap_options = c("striped", "hover"))| Dim.1 | Dim.2 | |
|---|---|---|
| ALFABET | 0.13 | 0.17 |
| INC_POB | 0.25 | 0.00 |
| ESPVIDAF | 0.10 | 0.38 |
| FERTILID | 0.20 | 0.11 |
| TASA_NAT | 0.21 | 0.11 |
| LOG_PIB | 0.10 | 0.23 |
r/ Al factor 1 debe asignarse el peso 0.72 y al factor 2 el peso 0.28. Para ALFABET será al facor 1: 0.13 y al factor 2: 0.17 Para INC_POB serán al F1: 0.25 y F2: 0 Para ESPVIDAF serán al F1: 0.1 y F2: 0.38 Para FERTILID serán al F1: 0.2 y F2: 0.11 Para TASA_NAT serán al F1: 0.2 y F2 0.11 Para LOG_PIB serán al F1: 0.1 y F2: 0.23
SECCION II.
una empresa se encuentra calculando un indicador del desempeño de sus lineas de produccion, para ello no dispone de informacionprevia, pero hay una importante consultora que posee expertos e3n el sector donde se ubica la empresa en cuestion.
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)
- Por suma
library(magrittr)
#Vector de Jerarquías
rj<-c(3,4,2,1)
names(rj)<-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<-ponderadores_subjetivos_rank_suma(rj)
#Pesos brutos
pesos_ranking_suma$w_brutos## X1 X2 X3 X4
## 2 1 3 4#Pesos normalizados
pesos_ranking_suma$w_normalizados %>% round(digits = 3)## X1 X2 X3 X4
## 0.2 0.1 0.3 0.4### GRAFICO
#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma$w_normalizados,
main = "Ponderadores Ranking de Suma",
ylim = c(0,0.5),col = "light green")
2. Por reciproco
#Vector de Jerarquías
rj<-c(3,4,2,1)
names(rj)<-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<-ponderadores_subjetivos_rank_reciproco(rj)
#Pesos brutos
pesos_ranking_reciproco$w_brutos## X1 X2 X3 X4
## 0.33333 0.25000 0.50000 1.00000#Pesos normalizados
pesos_ranking_reciproco$w_normalizados %>% round(digits = 3)## X1 X2 X3 X4
## 0.16 0.12 0.24 0.48### Grafico
#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco$w_normalizados,
main = "Ponderadores Ranking Recíproco",
ylim = c(0,0.5),col = "RED")
### 3. Por exponencial
#Vector de Jerarquías
rj<-c(3,4,2,1)
names(rj)<-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<-ponderadores_subjetivos_rank_exponencial(rj)
#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### Grafica
#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 = "brown")
## Ejercicio 2 Usando la técnica de comparación por pares, calcule los
pesos normalizados para las variables:
comparación por pares
library(FuzzyAHP)## Loading required package: MASS##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## select# Matriz_1
valores_matriz_comparacion_1 = c(1,7,4,5,
NA,1,6,3,
NA,NA,1,2,
NA,NA,NA,1)
matriz_comparacion_1<-matrix(valores_matriz_comparacion_1,
nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_1<-pairwiseComparisonMatrix(matriz_comparacion_1)
matriz_comparacion_1@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_1)## 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_1 = calculateWeights(matriz_comparacion_1)
show(pesos_normalizados_1)## An object of class "Weights"
## Slot "weights":
## w_X1 w_X2 w_X3 w_X4
## 0.606592 0.223310 0.094748 0.075350barplot(pesos_normalizados_1@weights,
main = "Ponderadores por método comparación de pares",
ylim = c(0,0.7),col = "yellow")
# Matriz_2
valores_matriz_comparacion_2 = c(1,7,6,3,
NA,1,5,2,
NA,NA,1,4,
NA,NA,NA,1)
matriz_comparacion_2<-matrix(valores_matriz_comparacion_2,
nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_2<-pairwiseComparisonMatrix(matriz_comparacion_2)
matriz_comparacion_2@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_2)## 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_2 = calculateWeights(matriz_comparacion_2)
show(pesos_normalizados_2)## An object of class "Weights"
## Slot "weights":
## w_X1 w_X2 w_X3 w_X4
## 0.60919 0.19879 0.10987 0.08215barplot(pesos_normalizados_2@weights,
main = "Ponderadores por método comparación de pares",
ylim = c(0,0.7),col = "blue")
# Matriz_3
valores_matriz_comparacion_3 = c(1,7,5,4,
NA,1,3,2,
NA,NA,1,6,
NA,NA,NA,1)
matriz_comparacion_3<-matrix(valores_matriz_comparacion_3,
nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_3<-pairwiseComparisonMatrix(matriz_comparacion_3)
matriz_comparacion_3@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_3)## 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_3 = calculateWeights(matriz_comparacion_3)
show(pesos_normalizados_3)## An object of class "Weights"
## Slot "weights":
## w_X1 w_X2 w_X3 w_X4
## 0.61676 0.17252 0.14259 0.06812barplot(pesos_normalizados_3@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.
library(kableExtra)
ponderacion_expertos <-1/3
pesos_tot<-(pesos_normalizados_1@weights+pesos_normalizados_2@weights+
pesos_normalizados_3@weights)
promedio_tot<-ponderacion_expertos*pesos_tot
show(promedio_tot)## w_X1 w_X2 w_X3 w_X4
## 0.610848 0.198207 0.115739 0.075207sum(promedio_tot)## [1] 1normalizacion_1<-promedio_tot/sum(promedio_tot)
show(normalizacion_1)## w_X1 w_X2 w_X3 w_X4
## 0.610848 0.198207 0.115739 0.0752072.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_distintas<-(pesos_normalizados_1@weights*0.25)+(pesos_normalizados_2@weights*0.35)+(pesos_normalizados_3@weights*0.4)
show(ponderacion_expertos_distintas)## w_X1 w_X2 w_X3 w_X4
## 0.611569 0.194412 0.119180 0.074838sum(ponderacion_expertos_distintas)## [1] 1normalizacion_2<-ponderacion_expertos_distintas/sum(ponderacion_expertos_distintas)
show(normalizacion_2)## w_X1 w_X2 w_X3 w_X4
## 0.611569 0.194412 0.119180 0.074838