Enunciado de la 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:
- A través del análisis de componentes principales, identifique para
un modelo de 3 factores:
library(dplyr)
library(tidyr)
library(kableExtra)
load("C:/Users/MINEDUCYT/Downloads/data_parcial_2_A_rev.RData")
norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}
## Seleccionando variables con correlación positiva
datos_parcial_2 %>%
dplyr::select(X1,X2,X3,X5,X7,X8) %>%
apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->var_corr_positiva
## Seleccionando variables con correlación negativa
datos_parcial_2 %>%
dplyr::select(X4,X6) %>%
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(X1,X2,X3,X4,X5,X6,X7,X8) ->datos_normalizados
head(datos_normalizados) %>%
kable(caption = "**Tabla:** las variables reordenadas.",
align = "c",
digits = 1) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla: las variables reordenadas.
|
X1
|
X2
|
X3
|
X4
|
X5
|
X6
|
X7
|
X8
|
|
0.2
|
0.0
|
0.0
|
0.8
|
0.0
|
1.0
|
0.0
|
0.2
|
|
0.2
|
0.0
|
0.5
|
0.5
|
0.4
|
0.8
|
0.1
|
0.5
|
|
0.2
|
0.1
|
0.4
|
0.5
|
0.6
|
0.9
|
0.2
|
0.5
|
|
0.2
|
0.0
|
0.3
|
0.6
|
0.2
|
0.9
|
0.4
|
0.4
|
|
0.1
|
0.0
|
0.7
|
0.2
|
0.9
|
0.5
|
0.1
|
0.7
|
|
0.1
|
0.0
|
0.2
|
0.7
|
0.3
|
0.6
|
0.3
|
0.3
|
|
Fuente:
|
|
PRACTICA.
|
Matrix RX
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_normalizados),histogram = TRUE,pch=12)
library(psych)
library(kableExtra)
# Calcular KMO
KMO_result <- KMO(datos_normalizados)
# Extraer el valor general KMO
KMO_value <- data.frame(KMO = round(KMO_result$MSA, 4))
# Mostrar tabla formateada
KMO_value %>%
kable(
caption = "**Tabla:** Prueba de adecuación muestral de Kaiser-Meyer-Olkin.",
col.names = "KMO",
align = "c",
digits = 4
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE) %>%
footnote(
general_title = "**Fuente**:",
general = "Práctica."
)
Tabla: Prueba de adecuación muestral de
Kaiser-Meyer-Olkin.
|
KMO
|
|
0.6793
|
|
Fuente:
|
|
Práctica.
|
library(psych)
Prueba_Barlett <- cortest.bartlett(datos_normalizados)
# Dando formato de Salida a Valores de la Prueba de Barlett
Prueba_Barlett <-
data.frame(Prueba_Barlett$chisq, Prueba_Barlett$p.value, Prueba_Barlett$df)
colnames(Prueba_Barlett) <- c("Chisq", "P-Value", "Df")
Prueba_Barlett %>%
kable(caption = "**Tabla:** Prueba de Barlett.",
align = "c",
digits = 1) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla: Prueba de Barlett.
|
Chisq
|
P-Value
|
Df
|
|
1025.9
|
0
|
28
|
|
Fuente:
|
|
PRACTICA.
|
Componentes principales:
library(factoextra)
library(kableExtra)
Rx<-cor(datos_normalizados)
PC<-princomp(x = datos_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_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Resumen 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
|
|
Fuente:
|
|
PRACTICA.
|
Gráfico de sedimentación
fviz_eig(PC,
choice = "eigenvalue",
barcolor = "pink",
barfill = "pink",
addlabels = TRUE,
)+ labs(title = "Grafico de Sedimentacion", subtitle = "Usando princomp con Autovalores") +
xlab(label = "Componentes principales") +
ylab(label = "Autovalores") + geom_hline(yintercept = 1)
Modelo de 3 Factores Rotados:
library(corrplot)
library(factoextra)
library(psych)
#Modelo de 2 Factores (Rotada)
numero_factores<-3
modelo_factores<-principal(r = Rx,
nfactors = numero_factores,
covar = FALSE,
rotate = "varimax")
modelo_factores
## Principal Components Analysis
## Call: principal(r = Rx, nfactors = numero_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
##
## Fit based upon off diagonal values = 0.98
correlaciones_modelo<-variables_pca$coord
rotacion<-varimax(correlaciones_modelo[,1:numero_factores])
correlaciones_modelo_rotada<-rotacion$loadings
a) Los ponderadores normalizados para cada factor.
library(kableExtra)
cargas<-rotacion$loadings[1:6,1:numero_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_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Ponderadores de los Factores Extraídos
|
Dim.1
|
Dim.2
|
Dim.3
|
|
0.41
|
0.27
|
0.32
|
|
Fuente:
|
|
PRACTICA.
|
b) Las variables incluidas en cada factor.
corrplot(correlaciones_modelo_rotada[,1:numero_factores],
is.corr = FALSE,
method = "square",
addCoef.col= "Black",
number.cex = 0.75)
2) Para el factor 1, utilice el método CRITIC para obtener los
ponderadores normalizados para cada variable
library(dplyr)
library(kableExtra)
#data_normalizada
datos_normalizados[,c(3,4,8)] -> data_factor_1
head(data_factor_1)
## X3 X4 X8
## 1 0.0400000 0.8000000 0.1582266
## 2 0.5500000 0.5000000 0.5167488
## 3 0.4000000 0.5000000 0.4679803
## 4 0.3142857 0.5714286 0.4133709
## 5 0.7000000 0.2500000 0.7339901
## 6 0.1600000 0.7000000 0.2551724
Cálculo de las desviaciones estándar de cada variable
data_factor_1 %>%
summarise(S3=sd(X3),S4=sd(X4),S8=sd(X8))-> sd_vector
print(sd_vector)
## S3 S4 S8
## 1 0.2462793 0.2011126 0.2087417
Cálculo de la matriz de correlación de la agrupacion
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
Cálculo 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.487552 0.7912904 0.4251658
Cálculo de los ponderadores netos
vj/sum(vj)->wj
names(wj)<- c("w_X3", "w_X4", "w_X8")
print(wj)
## w_X3 w_X4 w_X8
## 1 0.2861207 0.4643701 0.2495092
Ponderadores
round(wj*100,2) %>%
kable(caption = "Ponderadores normalizados de las variables correspondientes a la Agrupacion del factor 1",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Ponderadores normalizados de las variables correspondientes a la
Agrupacion del factor 1
|
w_X3
|
w_X4
|
w_X8
|
|
28.61
|
46.44
|
24.95
|
|
Fuente:
|
|
PRACTICA.
|
3) Para el factor 2, utilice el método de Entropía para obtener los
ponderadores normalizados para cada variable.
Normalizamos los datos
datos_parcial_2 %>% dplyr::select(X1,X2,X7)->data_factor_2
apply(data_factor_2,2,prop.table)->data_factor_2
head(data_factor_2)
## 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
Fórmula de entropía
entropy<-function(x){
return(x*log(x))
}
apply(data_factor_2,2,entropy)->data_norm_2
head(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
Número de variables en el factor
ncol(data_factor_2)->m
#Constante de entropía:
-1/log(m)->K
print(K)
## [1] -0.9102392
Cálculo de las entropías
K*colSums(data_norm_2)->Ej
print(Ej)
## X1 X2 X7
## 4.180549 3.202899 3.701923
Cálculo de las especificidades
1-Ej->vj_2
print(vj_2)
## X1 X2 X7
## -3.180549 -2.202899 -2.701923
Cálculo de los ponderadores
prop.table(vj_2)->wj_2
print(wj_2)
## X1 X2 X7
## 0.3933708 0.2724549 0.3341743
t(wj_2) %>% as.data.frame()->wj_2
round(wj_2*100,2) %>%
kable(caption = "Ponderadores de las Variables de la Agrupacion del Factor 2",
align = "c",
digits = 5) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Ponderadores de las Variables de la Agrupacion del Factor 2
|
X1
|
X2
|
X7
|
|
39.34
|
27.25
|
33.42
|
|
Fuente:
|
|
PRACTICA.
|
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)
Métodos de Ranking
rj_f3 <- c(1,2)
names(rj_f3)<-c("X5", "X6")
print(rj_f3)
## X5 X6
## 1 2
Jerarquia de Suma
# 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_f3)
# Pesos brutos
pesos_ranking_suma$w_brutos
## X5 X6
## 2 1
# Pesos normalizados
pesos_ranking_suma$w_normalizados %>% round(digits = 3)
## X5 X6
## 0.667 0.333
Jerarquia reciproca
library(magrittr)
#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_f3)
#Pesos brutos
pesos_ranking_reciproco$w_brutos
## X5 X6
## 1.0 0.5
# Pesos normalizados
pesos_ranking_reciproco$w_normalizados %>% round(digits = 3)
## X5 X6
## 0.667 0.333
Jerarquia Exponencial
#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<-ponderadores_subjetivos_rank_exponencial(rj_f3)
#Pesos brutos
pesos_ranking_exponencial$w_brutos
## X5 X6
## 4 1
#Pesos normalizados
pesos_ranking_exponencial$w_normalizados %>% round(digits = 3)
## X5 X6
## 0.8 0.2
pesos_ranking_suma$w_normalizados %>%
rbind(pesos_ranking_reciproco$w_normalizados) %>%
rbind(pesos_ranking_exponencial$w_normalizados) -> pesos_ranking
rownames(pesos_ranking)<- c("pesos_ranking_suma", "pesos_ranking_reciproco", "pesos_ranking_exponencial")
t(pesos_ranking) %>% as.data.frame()-> pesos_ranking
pesos_ranking %>% kable(caption="Peso ranking",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Peso ranking
|
|
pesos_ranking_suma
|
pesos_ranking_reciproco
|
pesos_ranking_exponencial
|
|
X5
|
0.67
|
0.67
|
0.8
|
|
X6
|
0.33
|
0.33
|
0.2
|
|
Fuente:
|
|
PRACTICA.
|
Ponderando cada metodo con la misma importancia relativa
# Promediamos los Ponderadores obtenidos por cada metdo de ranking
pesos_ranking_suma$w_normalizados +pesos_ranking_reciproco$w_normalizados + pesos_ranking_exponencial$w_normalizados -> Ponderadores
print(Ponderadores)
## X5 X6
## 2.1333333 0.8666667
# Ponderadores
prop.table(Ponderadores)* 100
## X5 X6
## 71.11111 28.88889
Enunciado de la 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.
library(magrittr)
library(kableExtra)
load("C:/Users/MINEDUCYT/Downloads/data_parcial_2_B_rev.RData")
head(data_parcial_2, n = 10) %>%
kable(caption = "**Tabla 1:** Data Original.",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla 1: Data Original.
|
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.48
|
NA
|
3.29
|
2.80
|
3.87
|
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.00
|
2.31
|
0.00
|
2.41
|
6.90
|
4.31
|
12
|
44
|
14
|
3
|
|
Alemania
|
81200
|
227.0
|
85
|
Protest.
|
79
|
73
|
99
|
0.36
|
6.5
|
17539
|
1
|
3443
|
11179
|
11
|
11
|
13.77
|
4.24
|
1.69
|
1.00
|
1.47
|
4.91
|
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.34
|
3.82
|
0.81
|
6.33
|
6.67
|
4.26
|
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.52
|
3.53
|
1.63
|
2.22
|
2.80
|
4.53
|
9
|
96
|
95
|
8
|
|
Armenia
|
3700
|
126.0
|
68
|
Ortodoxa
|
75
|
68
|
98
|
1.40
|
27.0
|
5000
|
5
|
NA
|
2
|
23
|
6
|
0.05
|
3.70
|
0.56
|
3.83
|
3.19
|
3.57
|
17
|
100
|
100
|
NA
|
|
Australia
|
17800
|
2.3
|
85
|
Protest.
|
80
|
74
|
100
|
1.38
|
7.3
|
16848
|
1
|
3216
|
4727
|
15
|
8
|
26.56
|
4.23
|
1.93
|
1.88
|
1.90
|
4.25
|
6
|
100
|
100
|
3
|
|
Austria
|
8000
|
94.0
|
58
|
Católica
|
79
|
73
|
99
|
0.20
|
6.7
|
18396
|
1
|
3495
|
1150
|
12
|
11
|
14.38
|
4.26
|
1.70
|
1.09
|
1.50
|
3.90
|
17
|
NA
|
NA
|
8
|
|
Bahrein
|
600
|
828.0
|
83
|
Musulma.
|
74
|
71
|
77
|
2.40
|
25.0
|
7875
|
5
|
NA
|
13
|
29
|
4
|
2.17
|
3.90
|
1.17
|
7.25
|
3.96
|
2.78
|
2
|
55
|
55
|
3
|
|
Bangladesh
|
125000
|
800.0
|
16
|
Musulma.
|
53
|
53
|
35
|
2.40
|
106.0
|
202
|
3
|
2021
|
1
|
35
|
11
|
0.00
|
2.31
|
0.24
|
3.18
|
4.70
|
5.10
|
67
|
47
|
22
|
5
|
|
Fuente:
|
|
PRACTICA.
|
# Cargando Paquetes
library(dplyr)
library(tidyr)
library(kableExtra)
# Creando funciones para normalización
norm_directa <- function(x) {
(x - min(x)) / (max(x) - min(x))
}
norm_inversa <- function(x) {
(max(x) - x) / (max(x) - min(x))
}
# Suprimir Val=NULL
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
# Normalizacion de Variables con Correlación Teórica Esperada Positiva
data_parcial_2 %>%
select(ALFABET, INC_POB, ESPVIDAF, FERTILID, TASA_NAT, LOG_PIB, URBANA) %>%
apply(MARGIN = 2,
FUN = norm_directa) %>%
as.data.frame() -> variables_positivas
# Normalizacion de Variables con Correlación Teórica Esperada Negativa
data_parcial_2 %>%
select(MORTINF, TASA_MOR) %>%
apply(MARGIN = 2,
FUN = norm_inversa) %>%
as.data.frame() -> variables_negativas
# Acoplamiento de las variables previamente normalizadas segun su correlación
variables_positivas %>%
bind_cols(variables_negativas) %>%
select(ALFABET,
INC_POB,
ESPVIDAF,
FERTILID,
TASA_NAT,
LOG_PIB,
URBANA,
MORTINF,
TASA_MOR) -> datos_normalizados
# Dandole formato a la muestra
head(datos_normalizados, n = 10) %>%
kable(
caption = "**Tabla 2:** Data Normalizada.",
col.names = c(
"Índice de alfabetización",
"Incremento Poblacional",
"Esperanza de Vida Femenina",
"Mortalidad Infantil",
"Promedio de Hijos por Mujer",
"Tasa de Natalidad",
"Logaritmo del PIB",
"Poblacion Urbana",
"Tasa de Mortalidad"
),
align = "c",
digits = 2
) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA")
Tabla 2: Data Normalizada.
|
Índice de alfabetización
|
Incremento Poblacional
|
Esperanza de Vida Femenina
|
Mortalidad Infantil
|
Promedio de Hijos por Mujer
|
Tasa de Natalidad
|
Logaritmo del PIB
|
Poblacion Urbana
|
Tasa de Mortalidad
|
|
0.98
|
0.31
|
0.82
|
0.34
|
0.30
|
0.61
|
0.54
|
0.81
|
0.71
|
|
0.29
|
0.56
|
0.03
|
0.84
|
1.00
|
0.10
|
0.18
|
0.00
|
0.08
|
|
0.99
|
0.12
|
0.92
|
0.18
|
0.02
|
0.94
|
0.85
|
0.98
|
0.54
|
|
0.62
|
0.63
|
0.69
|
0.81
|
0.65
|
0.76
|
0.77
|
0.71
|
0.75
|
|
0.95
|
0.29
|
0.82
|
0.34
|
0.23
|
0.63
|
0.86
|
0.87
|
0.62
|
|
0.98
|
0.31
|
0.82
|
0.39
|
0.30
|
0.71
|
0.68
|
0.86
|
0.75
|
|
1.00
|
0.30
|
0.95
|
0.23
|
0.12
|
0.94
|
0.85
|
0.98
|
0.67
|
|
0.99
|
0.09
|
0.92
|
0.18
|
0.05
|
0.95
|
0.58
|
0.98
|
0.54
|
|
0.77
|
0.49
|
0.79
|
0.48
|
0.44
|
0.79
|
0.83
|
0.87
|
0.83
|
|
0.35
|
0.49
|
0.26
|
0.57
|
0.58
|
0.10
|
0.16
|
0.38
|
0.54
|
|
Fuente:
|
|
PRACTICA
|
# Matriz Correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_normalizados),
histogram = TRUE,
pch = 12)
# Prueba KMO
library(psych)
library(kableExtra)
# Calcular KMO general y por variable
KMO_result <- KMO(datos_normalizados)
# Extraer el valor KMO general
KMO_tabla <- data.frame(KMO = round(KMO_result$MSA, 4))
# Mostrar tabla con formato
KMO_tabla %>%
kable(
caption = "**Tabla 3:** Prueba de adecuación muestral de Kaiser-Meyer-Olkin.",
col.names = "KMO",
align = "c",
digits = 4
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE) %>%
footnote(
general_title = "**Fuente**:",
general = "Elaboración propia con base en data Parcial 2 B."
)
Tabla 3: Prueba de adecuación muestral de
Kaiser-Meyer-Olkin.
|
KMO
|
|
0.8528
|
|
Fuente:
|
|
Elaboración propia con base en data Parcial 2 B.
|
# Prueba de Barlett
library(psych)
Barlett <- cortest.bartlett(datos_normalizados)
# Dando formato de Salida a Valores de la Prueba de Barlett
frame_bartlett <-
data.frame(Barlett$chisq, Barlett$p.value, Barlett$df)
colnames(frame_bartlett) <- c("Chisq", "P-Value", "Df")
frame_bartlett %>%
kable(caption = "**Tabla 4:** Prueba de Barlett.",
align = "c",
digits = 1) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla 4: Prueba de Barlett.
|
Chisq
|
P-Value
|
Df
|
|
1478.1
|
0
|
36
|
|
Fuente:
|
|
PRACTICA.
|
1.1 Usando Análisis Factorial determine cuántos factores deberían
retenerse.
library(FactoMineR)
library(factoextra)
library(kableExtra)
Rx <- cor(datos_normalizados)
PC <-
princomp(x = datos_normalizados, cor = TRUE, fix_sign = FALSE)
variables_pca <- get_pca_var(PC)
factoextra::get_eig(PC) %>%
kable(caption = "**Tabla 5:** Resumen de Análisis de Componentes Principales (PCA)",
col.names = c("Autovalores",
"Varianza (%)",
"Varianza Acumulada (%)"),
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla 5: Resumen de Análisis de Componentes Principales
(PCA)
|
|
Autovalores
|
Varianza (%)
|
Varianza Acumulada (%)
|
|
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
|
|
Fuente:
|
|
PRACTICA.
|
1.2 ¿Qué variables quedan representadas en cada factor?
Gráfico de sedimentación
fviz_eig(
PC,
choice = "eigenvalue",
barcolor = "Pink",
barfill = "Pink",
addlabels = TRUE,
) + labs(title = "Gráfico de Sedimentación",
subtitle = "Usando princomp, con Autovalores") +
xlab(label = "Componentes") +
ylab(label = "Autovalores") +
geom_hline(yintercept = 1)
library(corrplot)
# Modelo de 2 Factores (Rotado)
numero_de_factores <- 2
modelo_factores <- principal(
r = Rx,
nfactors = numero_de_factores,
covar = FALSE,
rotate = "varimax"
)
modelo_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
# Graficación
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 = "black",
tl.col = "black",
number.cex = 0.75
)
1.3 Determine qué 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:9, 1:numero_de_factores]
ponderadores <- prop.table(apply(cargas ^ 2, MARGIN = 2, sum))
t(ponderadores) %>%
kable(caption = "**Tabla 6:** Ponderadores de los Factores Extraídos",
col.names = c("Factor 1", "Factor 2"),
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla 6: Ponderadores de los Factores Extraídos
|
Factor 1
|
Factor 2
|
|
0.57
|
0.43
|
|
Fuente:
|
|
PRACTICA.
|
library(dplyr)
library(kableExtra)
# Contribuciones
contribuciones <- apply(cargas ^ 2, MARGIN = 2, prop.table)
data.frame(
contribuciones,
row.names = c(
"Índice de alfabetización",
"Incremento Poblacional",
"Esperanza de Vida Femenina",
"Promedio de Hijos por Mujer",
"Tasa de Natalidad",
"Logaritmo del PIB",
"Poblacion Urbana",
"Mortalidad Infantil",
"Tasa de Mortalidad"))%>%
kable(caption = "**Tabla 7:** Contribución de las variables en los Factores.",
col.names = c("Factor 1", "Factor 2"),
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T) %>%
column_spec(1, bold = T) %>%
footnote(general_title = "**Fuente**:",
general = "PRACTICA.")
Tabla 7: Contribución de las variables en los Factores.
|
|
Factor 1
|
Factor 2
|
|
Índice de alfabetización
|
0.11
|
0.08
|
|
Incremento Poblacional
|
0.22
|
0.00
|
|
Esperanza de Vida Femenina
|
0.09
|
0.17
|
|
Promedio de Hijos por Mujer
|
0.17
|
0.05
|
|
Tasa de Natalidad
|
0.19
|
0.05
|
|
Logaritmo del PIB
|
0.09
|
0.10
|
|
Poblacion Urbana
|
0.04
|
0.15
|
|
Mortalidad Infantil
|
0.10
|
0.15
|
|
Tasa de Mortalidad
|
0.00
|
0.25
|
|
Fuente:
|
|
PRACTICA.
|
Enunciado clave B - Seccion II
Ejercicio 1 [40%]: 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)
Ejercicio 2[35%]: 2.1 Usando la técnica de comparación por pares,
calcule los pesos normalizados para las variables: Asumiendo que la
opinión de los 3 expertos es igualmente válida. 2.2 Si el experto 1 se
pondera con 0.25, el experto 2 con 0.35 y el experto 3 con 0.4
Ejercicio 1 [40%]: 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)
# Este chunk es solo para mostrar el ranking
library(kableExtra)
rango<- c(3,4,2,1) %>% as.data.frame()
rango_transpose <- data.frame(t(rango))
colnames(rango_transpose)<-c("X1", "X2", "X3", "X4")
rownames(rango_transpose)<-"Ranking (Jerarquía)"
rango_transpose %>% kable() %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
|
|
X1
|
X2
|
X3
|
X4
|
|
Ranking (Jerarquía)
|
3
|
4
|
2
|
1
|
Método de Suma
library(magrittr)
library(kableExtra)
#Vector 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%>%
kable(caption = "**Tabla 8:** Peso Bruto por Método de Suma.",
col.names ="Peso Bruto",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
Tabla 8: Peso Bruto por Método de Suma.
|
|
Peso Bruto
|
|
X1
|
2
|
|
X2
|
1
|
|
X3
|
3
|
|
X4
|
4
|
pesos_ranking_suma$w_normalizados %>%
round(digits = 3) %>%
kable(
caption = "**Tabla 9:** Peso Normalizado por Metodo de Suma.",
col.names = "Peso Normalizado",
align = "c",
digits = 2
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE)
Tabla 9: Peso Normalizado por Metodo de Suma.
|
|
Peso Normalizado
|
|
X1
|
0.2
|
|
X2
|
0.1
|
|
X3
|
0.3
|
|
X4
|
0.4
|
Gráfico de pesos normalizados
barplot(
pesos_ranking_suma$w_normalizados,
main = "Ponderadores jerarquia de suma",
ylim = c(0, 0.5),
col = "Pink"
)
Método reciproco
# Configuración de idioma y codificación (evita errores con acentos)
if (.Platform$OS.type == "windows") {
Sys.setlocale("LC_ALL", "Spanish_Spain.1252")
} else {
Sys.setlocale("LC_ALL", "es_ES.UTF-8")
}
## Warning in Sys.setlocale("LC_ALL", "Spanish_Spain.1252"): using locale code
## page other than 65001 ("UTF-8") may cause problems
## [1] "LC_COLLATE=Spanish_Spain.1252;LC_CTYPE=Spanish_Spain.1252;LC_MONETARY=Spanish_Spain.1252;LC_NUMERIC=C;LC_TIME=Spanish_Spain.1252"
# Librerías
library(kableExtra)
# 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 (con acentos correctos y sin warnings)
pesos_ranking_reciproco$w_brutos %>%
kable(
caption = "**Tabla 10:** Peso Bruto por Método Recíproco",
col.names = "Peso Bruto",
align = "c",
digits = 2
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE)
Tabla 10: Peso Bruto por Método Recíproco
|
|
Peso Bruto
|
|
X1
|
0.33
|
|
X2
|
0.25
|
|
X3
|
0.50
|
|
X4
|
1.00
|
#Pesos normalizados
pesos_ranking_reciproco$w_normalizados %>% round(digits = 3)%>%
kable(caption = "**Tabla 11:** Peso Normalizado por Método de Recíproco",
col.names ="Peso Normalizado",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
Tabla 11: Peso Normalizado por Método de Recíproco
|
|
Peso Normalizado
|
|
X1
|
0.16
|
|
X2
|
0.12
|
|
X3
|
0.24
|
|
X4
|
0.48
|
#Gráfico de los pesos normalizados
barplot(
pesos_ranking_reciproco$w_normalizados,
main = "Ponderadores Ranking Recíproco",
ylim = c(0, 0.5),
col = "Pink"
)
#Por Método Exponencial (p=4)
#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%>%
kable(caption = "**Tabla 12:** Peso Bruto por Método Exponencial.",
col.names ="Peso Bruto",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
Tabla 12: Peso Bruto por Método Exponencial.
|
|
Peso Bruto
|
|
X1
|
16
|
|
X2
|
1
|
|
X3
|
81
|
|
X4
|
256
|
Ejercicio 2[35%]: Usando la técnica de comparación por pares, calcule
los pesos normalizados para las variables:
#Pesos normalizados
pesos_ranking_exponencial$w_normalizados %>% round(digits = 3)%>%
kable(caption = "**Tabla 13:** Peso Bruto por Método Exponencial.",
col.names ="Peso Normalizado",
align = "c",
digits = 2) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
Tabla 13: Peso Bruto por Método Exponencial.
|
|
Peso Normalizado
|
|
X1
|
0.04
|
|
X2
|
0.00
|
|
X3
|
0.23
|
|
X4
|
0.72
|
#Gráfico de los pesos normalizados (p=4)
barplot(
pesos_ranking_exponencial$w_normalizados,
main = "Ponderadores Ranking Exponencial",
ylim = c(0, 0.8),
col = "Pink"
)
library(FuzzyAHP)
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.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_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.60659194 0.22331004 0.09474784 0.07535018
2.1 Asumiendo que la opinión de los 3 expertos es igualmente
válida.
barplot(
pesos_normalizados_1@weights,
main = "Ponderadores por el Método de Comparación por Pares Experto 1",
ylim = c(0, 0.7),
col = "Pink"
)
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.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_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.60919010 0.19878595 0.10987399 0.08214997
barplot(
pesos_normalizados_2@weights,
main = "Ponderadores por el Método de Comparación por Pares Experto 2",
ylim = c(0, 0.7),
col = "Pink"
)
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.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"
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.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_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.61676222 0.17252382 0.14259384 0.06812013
barplot(
pesos_normalizados_3@weights,
main = "Ponderadores por el Método de Comparación de Pares Experto 3",
ylim = c(0, 0.7),
col = "Pink"
)
2.2 Si el experto 1 se pondera con 0.25, el experto 2 con 0.35 y el
experto 3 con 0.4
library(kableExtra)
ponderacion_expertos <- 1 / 3
pesos_tot <-
(
pesos_normalizados_1@weights + pesos_normalizados_2@weights +
pesos_normalizados_3@weights
)
promedio_tot <- ponderacion_expertos * pesos_tot
# Comprobando que la suma de 1 para verificar que es correcto
sum(promedio_tot)
## [1] 1
# Tabla 14: Peso Bruto con igual ponderación
promedio_tot %>%
kable(
caption = "**Tabla 14:** Peso Bruto con una misma ponderación de la opinión por experto.",
col.names = "Peso Bruto",
align = "c",
digits = 4
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE)
Tabla 14: Peso Bruto con una misma ponderación de la
opinión por experto.
|
|
Peso Bruto
|
|
w_X1
|
0.6108
|
|
w_X2
|
0.1982
|
|
w_X3
|
0.1157
|
|
w_X4
|
0.0752
|
# Normalización (Tabla 15)
normalizacion_1 <- promedio_tot / sum(promedio_tot)
normalizacion_1 %>%
kable(
caption = "**Tabla 15:** Peso normalizado con una misma ponderación de la opinión por experto.",
col.names = "Peso Normalizado",
align = "c",
digits = 4
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE)
Tabla 15: Peso normalizado con una misma ponderación de
la opinión por experto.
|
|
Peso Normalizado
|
|
w_X1
|
0.6108
|
|
w_X2
|
0.1982
|
|
w_X3
|
0.1157
|
|
w_X4
|
0.0752
|
Pesos distintos para cada experto: 25%, 35% y 40%
ponderacion_expertos_distintas <-
(pesos_normalizados_1@weights * 0.25)*100 +
(pesos_normalizados_2@weights * 0.35)*100 +
(pesos_normalizados_3@weights * 0.40)*100
ponderacion_expertos_distintas %>%
kable(
caption = "**Tabla X:** Peso Bruto con Diferente ponderacion de la opinion por Experto.",
col.names = "Peso Bruto",
align = "c",
digits = 2
) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
Tabla X: Peso Bruto con Diferente ponderacion de la
opinion por Experto.
|
|
Peso Bruto
|
|
w_X1
|
61.16
|
|
w_X2
|
19.44
|
|
w_X3
|
11.92
|
|
w_X4
|
7.48
|
# Verificando
sum(ponderacion_expertos_distintas)
## [1] 100
normalizacion_final <-
(ponderacion_expertos_distintas / sum(ponderacion_expertos_distintas))*100
#Verificando
sum(normalizacion_final)
## [1] 100
normalizacion_final %>%
kable(
caption = "**Tabla 16:** Peso Normalizado con Diferente ponderacion de la opinion por Experto.",
col.names = "Peso Normalizacion",
align = "c",
digits = 2
) %>%
kable_classic(html_font = "Times New Roman",
font_size = 14) %>%
row_spec(0, bold = T)
Tabla 16: Peso Normalizado con Diferente ponderacion de
la opinion por Experto.
|
|
Peso Normalizacion
|
|
w_X1
|
61.16
|
|
w_X2
|
19.44
|
|
w_X3
|
11.92
|
|
w_X4
|
7.48
|
# Normalización final (Tabla 17)
normalizacion_final <-
ponderacion_expertos_distintas / sum(ponderacion_expertos_distintas)
normalizacion_final %>%
kable(
caption = "**Tabla 17:** Peso normalizado con diferente ponderación de la opinión por experto.",
col.names = "Peso Normalizado",
align = "c",
digits = 4
) %>%
kable_classic(html_font = "Times New Roman", font_size = 14) %>%
row_spec(0, bold = TRUE)
Tabla 17: Peso normalizado con diferente ponderación de
la opinión por experto.
|
|
Peso Normalizado
|
|
w_X1
|
0.6116
|
|
w_X2
|
0.1944
|
|
w_X3
|
0.1192
|
|
w_X4
|
0.0748
|