Sección I.

Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías. Los indicadores a considerar son: el índice de alfabetización (alfabet)[+], el incremento de la población (inc_pob)[+], la esperanza de vida femenina (espvidaf)[+], la mortalidad infantil (mortinf)[-], el número promedio de hijos por mujer (fertilid)[+], la tasa de natalidad (tasa_nat)[+], el logaritmo del PIB (log_pib)[+], la población urbana (urbana)[+] y la tasa de mortalidad (tasa_mor)[-]. Entre Corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador. Todas las varibles se encuentran 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(magrittr)
library(kableExtra)
load("C:/Users/Torres/Desktop/Parcial1Ej1/data_parcial_2_B.RData")
head(data_parcial_2, n = 10) %>%
  kable(caption = "Tabla 1: Tabla proporcionada",
        align = "c",
        digits = 2) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T) %>%
  footnote(general_title = "Fuente:",
           general = "Elaboración propia con datos proporcionados")
Tabla 1: Tabla proporcionada
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:
Elaboración propia con datos proporcionados 
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
# Normalización 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


# Normalización 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 según 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


# formato de presentación de la muestra
head(datos_normalizados, n = 10) %>%
  kable(caption = "Tabla 2: Data Normalizada.",
    col.names = c(
      "indice de alfabetizacion",
      "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 = "Elaboracion propia con datos proporcionados")
Tabla 2: Data Normalizada.
indice de alfabetizacion 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:
Elaboracion propia con datos proporcionados 
# Matriz-Correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_normalizados),
                  histogram = TRUE,
                  pch = 12)

# Prueba: KMO
library(rela)
KMO <- paf(as.matrix(datos_normalizados))$KMO
# formato de Salida al valor KMO
KMO %>%
  kable(
    caption = "Tabla 3: Prueba de adecuacion 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 = T) %>%
  footnote(general_title = "Fuente:",
           general = "Elaboracion propia con datos proporcionados")
Tabla 3: Prueba de adecuacion muestral de Kaiser Meyer Olkin.
KMO
0.8528
Fuente:
Elaboracion propia con datos proporcionados 
# Prueba de Barlett
library(psych)
Barlett <- cortest.bartlett(datos_normalizados)
# 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 = "Elaboracion propia con datos proporcionados")
Tabla 4: Prueba de Barlett
Chisq P-Value Df
1478.1 0 36
Fuente:
Elaboracion propia con datos proporcionados

Ya que la Prueba de adecuación muestral de Kaiser Meyer Olkin (KMO) > 0.5 y que el P-Value < 0.05, se considera adecuado el analisis factorial empleado porque existe multicolinealidad en los valores de la matriz de informacion

Liteal 1.1

Utilizando Analisis Factorial determine cuantos factores pueden retenerse: Analisis de Componentes

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 analisis 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 = "Elaboración propia con datos proporcionados")
Tabla 5: Resumen de analisis 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:
Elaboración propia con datos proporcionados

grafica de sediemntacion

fviz_eig(
  PC,
  choice = "eigenvalue",
  barcolor = "#F8A29E",
  barfill = "#F8A29E",
  addlabels = TRUE,
) + labs(title = "Grafica de Sedimentacion", 
         subtitle = "Usando princomp, con Autovalores") +
  xlab(label = "Componentes") +
  ylab(label = "Autovalores") + 
  geom_hline(yintercept = 1)

literal 1.2

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

grafica del modelo anterior

#grafica
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 
)

En el factor 1 quedan representadas 5 Variables: * ALFABET. * INC_POB. * FÉRTIL. * TASA_NAT. * LOG_PIB. En el factor 2 quedan representadas 4 Variables: * ESPVIDAF. * URBANO. * MORTINF.

##literal 1.3

# Cargas de cada dimension
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 = "Elaboración propia con datos proporcionados")
Tabla 6: Ponderadores de los Factores Extraídos
Factor 1 Factor 2
0.57 0.43
Fuente:
Elaboración propia con datos proporcionados 
library(dplyr)
library(kableExtra)
# Contribuciones
contribuciones <- apply(cargas ^ 2, MARGIN = 2, prop.table)
  data.frame(
    contribuciones,
    row.names = c(
      "indice de alfabetizacion",
      "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 = "Elaboración propia con datos proporcionados")
Tabla 7: Contribución de las variables en los Factores.
Factor 1 Factor 2
indice de alfabetizacion 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:
Elaboración propia con datos proporcionados

Sección II.

Una empresa se encuentra calculando un Indicador del desempeño de sus líneas de producción, para ello no dispone de información previa, pero hay una importante consultora que posee expertos en el sector donde se ubica la empresa en cuestión. La consultora, ha han determinado 4 variables que definen adecuadamente el desempeño de las líneas de producción: X1: Mantenimiento de la línea de producción X2: Tamaño de planta X3: Logística (entradas y salidas de insumos y producción) X4: Capacidad de innovación. La consultora jerarquizó las variables de la siguiente manera:

Variable

X1

X2

X3

X4

Ranking

3

4

2

1

 

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)

por medio de suma

library(magrittr)
library(kableExtra)
#Vector jerarquias
rj <- c(3, 4, 2, 1)
names(rj) <- c("X1", "X2", "X3", "X4")
#Funcion 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 funcion:
pesos_ranking_suma<-ponderadores_subjetivos_rank_suma(rj)
#Pesos brutos
pesos_ranking_suma$w_brutos%>%
  kable(caption = " Peso Bruto por Metodo 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)
Peso Bruto por Metodo de Suma.
Peso Bruto
X1 2
X2 1
X3 3
X4 4 
#pesos normalizados
pesos_ranking_suma$w_normalizados %>% round(digits = 3)%>%
  kable(caption = " 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 = T)
Peso Normalizado por Metodo de Suma.
Peso Normalizado
X1 0.2
X2 0.1
X3 0.3
X4 0.4
graficas
barplot(
  pesos_ranking_suma$w_normalizados,
  main = "Ponderadores Jerarquia de Suma",
  ylim = c(0, 0.5),
  col = "#F8A29E"
)

por metodo reciproco

#Vector de Jerarquias
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%>%
  kable(caption = " Peso Bruto por metodo Reciproco",
        col.names ="Peso Bruto", 
        align = "c",
        digits = 2) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso Bruto por metodo Reciproco
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 = "Peso Normalizado por metodo de Reciproco",
        col.names ="Peso Normalizado", 
        align = "c",
        digits = 2) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso Normalizado por metodo de Reciproco
Peso Normalizado
X1 0.16
X2 0.12
X3 0.24
X4 0.48
graficas
#grafico de los pesos normalizados
barplot(
  pesos_ranking_reciproco$w_normalizados,
  main = "Ponderadores ranking reciproco",
  ylim = c(0, 0.5),
  col = "#F8A29E"
)

por metodo exponencial (p=4)

#Vector de Jerarquias
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 = " Peso Bruto por Metodo Exponencial.",
        col.names ="Peso Bruto", 
        align = "c",
        digits = 2) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso Bruto por Metodo Exponencial.
Peso Bruto
X1 16
X2 1
X3 81
X4 256 
#Pesos normalizados
pesos_ranking_exponencial$w_normalizados %>% round(digits = 3)%>%
  kable(caption = " Peso Bruto por Metodo Exponencial.",
        col.names ="Peso Normalizado", 
        align = "c",
        digits = 2) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso Bruto por Metodo Exponencial.
Peso Normalizado
X1 0.04
X2 0.00
X3 0.23
X4 0.72
graficas
#Gráfico de los pesos normalizados (p=4)
barplot(
  pesos_ranking_exponencial$w_normalizados,
  main = "Ponderadores Ranking exponencial",
  ylim = c(0, 0.8),
  col = "#F8A29E"
)

ejercico 2

Usando la técnica de comparación por pares, calcule los pesos normalizados para las variables: 2.1.) 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

experto 1

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.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.075350

grafica

barplot(
  pesos_normalizados_1@weights,
  main = "Ponderadores por el Metodo de Comparacion por Pares Experto 1",
  ylim = c(0, 0.7),
  col = "#F8A29E"
)

Experto 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.08215

grafica

barplot(
  pesos_normalizados_2@weights,
  main = "Ponderadores por el Metodo de Comparación por Pares Experto 2",
  ylim = c(0, 0.7),
  col = "#F8A29E"
)

Experto 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.06812

grafica

barplot(
  pesos_normalizados_3@weights,
  main = "Ponderadores por el Método de Comparación de Pares Experto3",
  ylim = c(0, 0.7),
  col = "#F8A29E"
)

ejercicio del 2.1

si se asume que la opinion de los 3 es valida

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
# Muestra y formato de los Resultados
promedio_tot %>%
  kable(
    caption = "Peso bruto con una misma ponderacion de la opinion por Experto.",
    col.names = "Peso Bruto",
    align = "c",
    digits = 4
  ) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso bruto con una misma ponderacion de la opinion por Experto.
Peso Bruto
w_X1 0.6108
w_X2 0.1982
w_X3 0.1157
w_X4 0.0752 
normalizacion_1 <- promedio_tot / sum(promedio_tot)
normalizacion_1 %>%   
  kable(
    caption = "Peso Normalizado con una Misma ponderacion de la opinion por Experto.",
    col.names = "Peso Normalizacion",
    align = "c",
    digits = 4
  ) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso Normalizado con una Misma ponderacion de la opinion por Experto.
Peso Normalizacion
w_X1 0.6108
w_X2 0.1982
w_X3 0.1157
w_X4 0.0752
ejercicio del 2.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)*100 +
  (pesos_normalizados_2@weights * 0.35)*100 +
  (pesos_normalizados_3@weights * 0.40)*100

ponderacion_expertos_distintas %>%
  kable(
    caption = "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)
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 = "**Peso Normalizado con Diferente ponderacion de la opinion por Expert**.",
    col.names = "Peso Normalizacion",
    align = "c",
    digits = 2
  ) %>%
  kable_classic(html_font = "Times New Roman",
                font_size = 14) %>%
  row_spec(0, bold = T)
Peso Normalizado con Diferente ponderacion de la opinion por Expert.
Peso Normalizacion
w_X1 61.16
w_X2 19.44
w_X3 11.92
w_X4 7.48