Practica U2 PM18112

Clave A

cargando datos

load("~/MAE1182022/PRACTICA CLAVE A Y B/data_parcial_2_A_rev.RData")

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:

Variable		Correlación con la variable compleja
X1	% de Negocios victimizados durante el año por - robo o hurto	positiva
X2	% de Negocios victimizados durante el año - extorsión o secuestro	positiva
X3	% de Negocios que consideran que el crimen fue mayor en el año actual comparado con el año anterior	positiva
X4	% de Negocios que consideran que el crimen local es mayor que en los municipios vecinos	negativa
X5	Erogaciones municipales per cápita en seguridad pública (US$)	positiva
X6	Costo del crimen a negocios por cada US$1,000 de ventas durante el año previo	negativa
X7	% de Negocios que califican a la municipalidad como buena en prevención y control del delito	positiva
X8	% de Negocios que consideran que la calidad del alumbrado público es adecuada para la seguridad de los negocios en el municipio	positiva

1. (25%) A través del análisis de componentes principales, identifique para un modelo de 3 factores:

library(psych)
library(corrplot)
library(dplyr)
library(Hmisc)
library(factoextra)
library(ggplot2)
library(kableExtra)

#Matriz R

datos_parcial_2[, 3:10] -> mX

mX %>% head(5) %>% kable(caption = "Matriz de información:" ,
                         align = "c",
                         digits = 6) %>%  kable_material(html_font = "sans-serif")

Matriz de información:
X1	X2	X3	X4	X5	X6	X7	X8
9	2	20.00000	20.00000	0.00000	0.000000	2	56.4000
10	6	62.50000	50.00000	37.50000	3.947368	11	147.3750
10	20	50.00000	50.00000	50.00000	2.564103	16	135.0000
8	3	42.85714	42.85714	14.28571	1.351351	35	121.1429
7	7	75.00000	75.00000	75.00000	9.090909	8	202.5000

cov(mX) -> vX

vX %>%
  kable(caption = "Cálculo de V(X)",
        align = "c",
        digits = 2) %>% kable_material(html_font = "sans-serif") %>%  kable_styling(bootstrap_options = c("striped", "hover"))

Cálculo de V(X)
	X1	X2	X3	X4	X5	X6	X7	X8
X1	26.11	144.11	-20.95	-18.72	-18.07	-2.03	49.66	-50.54
X2	144.11	3069.81	-29.28	5.04	-50.64	-1.80	568.21	-22.91
X3	-20.95	-29.28	421.20	387.45	264.02	47.63	-63.91	1042.56
X4	-18.72	5.04	387.45	404.46	263.29	44.42	-42.59	1060.83
X5	-18.07	-50.64	264.02	263.29	460.59	68.27	-29.20	703.82
X6	-2.03	-1.80	47.63	44.42	68.27	21.03	-9.00	119.34
X7	49.66	568.21	-63.91	-42.59	-29.20	-9.00	360.78	-120.08
X8	-50.54	-22.91	1042.56	1060.83	703.82	119.34	-120.08	2805.63

cor(mX) -> Rx

Rx %>%  kable(caption = "Cálculo de R(X)",
              align = "c",
              digits = 2) %>%  kable_material(html_font = "sans-serif") %>%  kable_styling(bootstrap_options = c("striped", "hover"))

Cálculo de R(X)
	X1	X2	X3	X4	X5	X6	X7	X8
X1	1.00	0.51	-0.20	-0.18	-0.16	-0.09	0.51	-0.19
X2	0.51	1.00	-0.03	0.00	-0.04	-0.01	0.54	-0.01
X3	-0.20	-0.03	1.00	0.94	0.60	0.51	-0.16	0.96
X4	-0.18	0.00	0.94	1.00	0.61	0.48	-0.11	1.00
X5	-0.16	-0.04	0.60	0.61	1.00	0.69	-0.07	0.62
X6	-0.09	-0.01	0.51	0.48	0.69	1.00	-0.10	0.49
X7	0.51	0.54	-0.16	-0.11	-0.07	-0.10	1.00	-0.12
X8	-0.19	-0.01	0.96	1.00	0.62	0.49	-0.12	1.00

Rx <- mX %>% as.matrix() %>% rcorr()

a. Los ponderadores normalizados para cada factor.

#Descomposición de autovalores y autovectores

PC <- princomp(x = mX, cor = TRUE, fix_sign = FALSE)

factoextra::get_eig(PC) %>% kable(caption = "Resumen de PCA",
                                  align = "c",
                                  digits = 2) %>%  kable_material(html_font = "sans-serif") %>%  kable_styling(bootstrap_options = c("hover"))

Resumen de PCA
	eigenvalue	variance.percent	cumulative.variance.percent
Dim.1	3.90	48.72	48.72
Dim.2	1.96	24.55	73.27
Dim.3	0.84	10.52	83.78
Dim.4	0.50	6.24	90.03
Dim.5	0.45	5.68	95.70
Dim.6	0.28	3.45	99.16
Dim.7	0.07	0.82	99.98
Dim.8	0.00	0.02	100.00

varpca <- get_pca_var(PC)

varpca$coord %>%  kable(caption = "Correlación de X con las componentes",
                        align = "c",
                        digits = 2) %>% kable_material(html_font = "sans-serif") %>%  kable_styling(bootstrap_options = c("striped", "hover"))

Correlación de X con las componentes
	Dim.1	Dim.2	Dim.3	Dim.4	Dim.5	Dim.6	Dim.7	Dim.8
X1	0.32	-0.75	-0.05	0.52	0.24	-0.07	0.00	0.00
X2	0.12	-0.83	0.07	-0.05	-0.53	-0.06	0.00	0.00
X3	-0.93	-0.10	0.26	0.06	0.02	0.06	-0.21	-0.01
X4	-0.94	-0.15	0.29	0.02	0.04	0.02	0.13	-0.03
X5	-0.78	-0.11	-0.45	-0.13	0.07	-0.39	-0.01	0.00
X6	-0.68	-0.12	-0.63	0.09	-0.08	0.32	0.01	0.00
X7	0.25	-0.79	0.00	-0.45	0.31	0.11	-0.01	0.00
X8	-0.94	-0.14	0.28	0.02	0.05	0.02	0.07	0.03

b. Las variables incluidas en cada factor.

#Correlograma

factores <- 3
cor_mod <- varpca$coord


corrplot(
  cor_mod[, 1:factores],
  is.corr = FALSE,
  method = "square",
  addCoef.col = "black",
  number.cex = 0.75
)

2. (25%) Para el factor 1, utilice el método CRITIC para obtener los ponderadores normalizados para cada variable.

#Factor 1 X3, X4, X8

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

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

datos_parcial_2 %>% select(X3, X4, X8) %>% transmute(X3 = norm_directa(X3),
                                                     X4 = norm_inversa(X4),
                                                     X8 = norm_directa(X8)) -> f1

f1

## # A tibble: 108 × 3
##       X3    X4    X8
##    <dbl> <dbl> <dbl>
##  1 0.04  0.8   0.158
##  2 0.55  0.5   0.517
##  3 0.4   0.5   0.468
##  4 0.314 0.571 0.413
##  5 0.7   0.25  0.734
##  6 0.16  0.7   0.255
##  7 0.673 0.273 0.714
##  8 0.55  0.5   0.446
##  9 0.4   0.563 0.433
## 10 0.68  0.467 0.552
## # … with 98 more rows

f1 %>% summarise(S3 = sd(X3),
                 S4 = sd(X4),
                 S8 = sd(X8)) -> sd_v

sd_v

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

cor(f1) -> mRf1

mRf1

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

#Ponderadores Brutos

1 - mRf1 -> s_data

colSums(s_data) -> s_vector

sd_v * s_vector -> vj

vj

##         S3        S4        S8
## 1 0.487552 0.7912904 0.4251658

#Ponderadores netos

vj / sum(vj) -> wj

wj

##          S3        S4        S8
## 1 0.2861207 0.4643701 0.2495092

round(wj * 100, 2) -> Ponderadores

Ponderadores

##      S3    S4    S8
## 1 28.61 46.44 24.95

3. (25%) Para el factor 2, utilice el método de Entropía para obtener los ponderadores normalizados para cada variable.

#Factor 2 X1, X2, X7

datos_parcial_2 %>% select(X1, X2, X7) -> f2

apply(f2, 2, prop.table) -> f2

f2 %>% head(5)

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

entropia <- function(x) {
  return(x * log(x))
}

apply(f2, 2, entropia) -> f22

f22 %>% head(5)

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

ncol(f2) -> m

- 1 / log(m) -> K

K

## [1] -0.9102392

#calculo de entropias

K * colSums(f22) -> Ej

Ej

##       X1       X2       X7 
## 4.180549 3.202899 3.701923

#Especificidades

1 - Ej -> vj

vj

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

# Ponderadores

prop.table(vj) -> wj

wj

##        X1        X2        X7 
## 0.3933708 0.2724549 0.3341743

4. (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).

Jerarquia de sumas

library(magrittr)
#vector de jerarquias

rj <- c(1:3)

names(rj) <- c("X4", "X5", "X6")

rj

## X4 X5 X6 
##  1  2  3

#pesos

psrs <- 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))
}

prs <- psrs(rj)

#pesos brutos
prs$w_brutos

## X4 X5 X6 
##  3  2  1

#pesos normalizados
prs$w_normalizados %>% round(digits = 3)

##    X4    X5    X6 
## 0.500 0.333 0.167

barplot(
  prs$w_normalizados,
  main = "Ponderadores Ranking de Suma",
  ylim = c(0, 0.5),
  col = "gray"
)

Jerarquia reciproca

psrr <- function(vector_jerarquias) {
  vector_pesos <- 1 / vector_jerarquias
  list(w_brutos = vector_pesos,
       w_normalizados = vector_pesos / sum(vector_pesos))
}

prr <- psrr(rj)

#Pesos brutos

prr$w_brutos

##        X4        X5        X6 
## 1.0000000 0.5000000 0.3333333

#Pesos normalizados

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

##    X4    X5    X6 
## 0.545 0.273 0.182

barplot(
  prr$w_normalizados,
  main = "Ponderadores Ranking Recíproco",
  ylim = c(0, 0.5),
  col = "pink"
)

Jerarquia Exponencial

psre <- 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))
}

pre<-psre(rj)

#Pesos brutos

pre$w_brutos

## X4 X5 X6 
##  9  4  1

#Pesos normalizados

pre$w_normalizados

##         X4         X5         X6 
## 0.64285714 0.28571429 0.07142857

barplot(pre$w_normalizados,
        main = "Ponderadores Ranking Exponencial",
        ylim = c(0,0.5),col = "blue")

Clave B

Seccion I 25%

carga de datos

load("~/MAE1182022/PRACTICA CLAVE A Y B/data_parcial_2_B_rev.RData")

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

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

data_parcial_2[is.na(data_parcial_2)] <- 0

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

data_parcial_2 %>% select(MORTINF, TASA_MOR) %>% apply(MARGIN = 2, FUN = norm_inversa) %>% as.data.frame() ->
  vcorn

vcorp %>%  bind_cols(vcorn) %>% select(ALFABET,
                                       INC_POB,
                                       ESPVIDAF,
                                       FERTILID,
                                       TASA_NAT,
                                       LOG_PIB,
                                       URBANA,
                                       MORTINF,
                                       TASA_MOR) -> d_norm

head(d_norm)

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

library(PerformanceAnalytics)
library(rela)
library(psych)
chart.Correlation(as.matrix(d_norm), histogram = TRUE, pch = 12)

KMO <- paf(as.matrix(d_norm))$KMO
print(KMO)

## [1] 0.85275

options(scipen = 99999)
Barlett <- cortest.bartlett(d_norm)
print(Barlett)

## $chisq
## [1] 1478.1
## 
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000017846
## 
## $df
## [1] 36

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

Rx <- cor(d_norm)
PC <- princomp(x = d_norm, cor = TRUE, fix_sign = FALSE)
variables_pca <- get_pca_var(PC)
factoextra::get_eig(PC) %>% kable(caption = "Resumen de PCA",
                                  align = "c",
                                  digits = 2) %>%
  kable_material(html_font = "sans-serif") %>%
  kable_styling(bootstrap_options = c("hover"))

Resumen de PCA
	eigenvalue	variance.percent	cumulative.variance.percent
Dim.1	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

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

Interpretación: Según el analisis factorial se deben retener dos factores

1.2) ¿Qué variables quedan representadas en cada factor?

factores <- 2
mf <-
  principal(
    r = Rx,
    nfactors = factores,
    covar = FALSE,
    rotate = "varimax"
  )
mf

## Principal Components Analysis
## Call: principal(r = Rx, nfactors = 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

corm <- variables_pca$coord
rotacion <- varimax(corm[, 1:factores])
cormr <- rotacion$loadings

corrplot(
  cormr[, 1:factores],
  is.corr = FALSE,
  method = "square",
  addCoef.col = "black",
  number.cex = 0.75
)

Interpretación: El primer factor esta representado por las variables del Incremento de la población (INC_POB), el numero promedio de hijos por mujer (FERTILID), y la tasa de natalidad (TASA_NAT). Mientras que el segundo factor esta representado la Tasa de mortalidad (TASA_MOR) y la esperanza de vida femenina (ESPVIDAF).

1.3) Determine qué pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

pesos <- rotacion$loadings[1:6, 1:factores]
ponderadores <- prop.table(apply(pesos ^ 2, MARGIN = 2, sum))
t(ponderadores) %>% kable(caption = "Ponderadores de los Factores Extraídos",
                          align = "c",
                          digits = 2) %>%
  kable_material(html_font = "sans-serif") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))

Ponderadores de los Factores Extraídos
Dim.1	Dim.2
0.72	0.28

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:

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

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

Dentro de la consultora hay 3 expertos que propusieron la jerarquía anterior, pero también realizaron un ejercicio de comparación por pares y los resultados fueron los siguientes:

Experto1 <- c(
  "Comparación",
  "Jerarquia",
  "X1 & X2",
  "7",
  "X1 & X3",
  "4",
  "X1 & X4",
  "5",
  "X2 & X3",
  "6",
  "X2 & X4",
  "3",
  "X3 & X4",
  "2"
) %>% matrix(nrow = 7, ncol = 2, byrow = T) -> Experto1

Experto1 %>% kable(caption = "EXPERTO 1") %>% kable_styling()

EXPERTO 1
Comparación	Jerarquia
X1 & X2	7
X1 & X3	4
X1 & X4	5
X2 & X3	6
X2 & X4	3
X3 & X4	2

Experto2 <- c(
  "Comparación",
  "Jerarquia",
  "X1 & X2",
  "7",
  "X1 & X3",
  "6",
  "X1 & X4",
  "3",
  "X2 & X3",
  "5",
  "X2 & X4",
  "2",
  "X3 & X4",
  "4"
) %>% matrix(nrow = 7, ncol = 2, byrow = T) -> Experto2

Experto2 %>% kable(caption = "EXPERTO 2") %>% kable_styling()

EXPERTO 2
Comparación	Jerarquia
X1 & X2	7
X1 & X3	6
X1 & X4	3
X2 & X3	5
X2 & X4	2
X3 & X4	4

Experto3 <- c(
  "Comparación",
  "Jerarquia",
  "X1 & X2",
  "7",
  "X1 & X3",
  "5",
  "X1 & X4",
  "4",
  "X2 & X3",
  "3",
  "X2 & X4",
  "2",
  "X3 & X4",
  "6"
) %>% matrix(nrow = 7, ncol = 2, byrow = T) -> Experto3

Experto3 %>% kable(caption = "EXPERTO 3") %>% kable_styling()

EXPERTO 3
Comparación	Jerarquia
X1 & X2	7
X1 & X3	5
X1 & X4	4
X2 & X3	3
X2 & X4	2
X3 & X4	6

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)

Jerarquia de suma

prs1 <- psrs(ri)


prs1$w_brutos

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

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

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

barplot(
  prs1$w_normalizados,
  main = "Ponderadores Ranking de Suma",
  ylim = c(0, 0.5),
  col = "yellow"
)

Jerarquia Reciproca

prr1 <- psrr(ri)

prr1$w_brutos

##      X1      X2      X3      X4 
## 0.33333 0.25000 0.50000 1.00000

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

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

barplot(
  prr1$w_normalizados,
  main = "Ponderadores Ranking Recíproco",
  ylim = c(0, 0.6),
  col = "coral"
)

Jerarquia Exponencial

pre1 <- psre(ri)

pre1$w_brutos

## X1 X2 X3 X4 
##  4  1  9 16

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

##    X1    X2    X3    X4 
## 0.133 0.033 0.300 0.533

barplot(
  pre1$w_normalizados,
  main = "Ponderadores Ranking Exponencial",
  ylim = c(0, 1),
  col = "magenta"
)

Ejercicio 2[35%]: 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.

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

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

#Pesos Normalizados

pesos_normalizados = calculateWeights(MC)
show(pesos_normalizados)

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

barplot(
  pesos_normalizados@weights,
  main = "Ponderadores por comparación de pares",
  ylim = c(0, 1),
  col = "dark green"
)

mc2 = c(1, 7, 6, 3,
        NA, 1, 5, 2,
        NA, NA, 1, 4,
        NA, NA, NA, 1) %>% matrix(nrow = 4, ncol = 4, byrow = TRUE) ->
  MC_2
MC_2 <- pairwiseComparisonMatrix(MC_2)
MC_2@variableNames <- c("X1", "X2", "X3", "X4")
show(MC_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"

#Pesos Normalizados

pesos_normalizados2 = calculateWeights(MC_2)
show(pesos_normalizados2)

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

barplot(
  pesos_normalizados2@weights,
  main = "Ponderadores por comparación de pares",
  ylim = c(0, 1),
  col = "dark red"
)

mc3 = c(1, 7, 5, 4,
        NA, 1, 3, 2,
        NA, NA, 1, 6,
        NA, NA, NA, 1) %>%  matrix(nrow = 4, ncol = 4, byrow = TRUE) -> MC_3
MC_3 <- pairwiseComparisonMatrix(MC_3)
MC_3@variableNames <- c("X1", "X2", "X3", "X4")
show(MC_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"

pesos_normalizados3 = calculateWeights(MC_3)
show(pesos_normalizados3)

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

barplot(
  pesos_normalizados3@weights,
  main = "Ponderadores por comparación de pares",
  ylim = c(0, 1),
  col = "dark blue"
)

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

pesos<-round(0.25*pesos_normalizados@weights+0.35*pesos_normalizados2@weights+0.4*pesos_normalizados3@weights,digits = 6)*100

pesos %>% as.data.frame() %>% kable(caption = "Pesos") %>% kable_minimal()

Pesos
	.
w_X1	61.1569
w_X2	19.4412
w_X3	11.9180
w_X4	7.4838

Practica U2 PM18112

KARLA REGINA PANIAGUA MUÑOZ PM18112

2022-10-25

Clave A

cargando datos

1. (25%) A través del análisis de componentes principales, identifique para un modelo de 3 factores:

a. Los ponderadores normalizados para cada factor.

b. Las variables incluidas en cada factor.

2. (25%) Para el factor 1, utilice el método CRITIC para obtener los ponderadores normalizados para cada variable.

3. (25%) Para el factor 2, utilice el método de Entropía para obtener los ponderadores normalizados para cada variable.

4. (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).

Jerarquia de sumas

Jerarquia reciproca

Jerarquia Exponencial

Clave B

Seccion I 25%

carga de datos

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

1.2) ¿Qué variables quedan representadas en cada factor?

Sección 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)

Jerarquia de suma

Jerarquia Reciproca

Jerarquia Exponencial

Ejercicio 2[35%]: 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.