A21_21033

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:

knitr::include_graphics("/Users/cesiayasmin/Desktop/imagen A21 .jpeg")

load("/Users/cesiayasmin/Downloads/data_parcial_2_A_rev.RData")

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

library(kableExtra)
mat_X<-datos_parcial_2
mat_X_uno<-mat_X[,c(-1,-2)]
mat_X_uno %>% head() %>% 
  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
6	13	30.00000	30.00000	30.00000	8.108108	25	81.0000

** Normalizacion de los datos **

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:kableExtra':
## 
##     group_rows

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

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

#Selección de variables con correlación positiva para la Salud Financiera
mat_X_uno %>% 
  select(X1,X2,X3,X5,X6,X8) %>% 
  apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->vbles_corrlcn_positiva

#Selección de variables con correlación negativa para la Salud Financiera
mat_X_uno %>% 
  select(X4,X7) %>% 
  apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->vbles_corrlcn_negativa

#Union y reordenamiento de variables
vbles_corrlcn_positiva %>% 
  bind_cols(vbles_corrlcn_negativa) %>% 
  select(X1,X2,X3,X4,X5,X6,X7,X8)->datos_normalizados
head(datos_normalizados)

##           X1          X2        X3        X4        X5         X6        X7
## 1 0.19354839 0.000000000 0.0400000 0.8000000 0.0000000 0.00000000 1.0000000
## 2 0.22580645 0.017167382 0.5500000 0.5000000 0.4285714 0.21558704 0.9010989
## 3 0.22580645 0.077253219 0.4000000 0.5000000 0.5714286 0.14003945 0.8461538
## 4 0.16129032 0.004291845 0.3142857 0.5714286 0.1632653 0.07380457 0.6373626
## 5 0.12903226 0.021459227 0.7000000 0.2500000 0.8571429 0.49650350 0.9340659
## 6 0.09677419 0.047210300 0.1600000 0.7000000 0.3428571 0.44282744 0.7472527
##          X8
## 1 0.1582266
## 2 0.5167488
## 3 0.4679803
## 4 0.4133709
## 5 0.7339901
## 6 0.2551724

** Matriz de correlacion **

library(PerformanceAnalytics)

## Loading required package: xts

## Warning: package 'xts' was built under R version 4.4.1

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################

## 
## Attaching package: 'xts'

## The following objects are masked from 'package:dplyr':
## 
##     first, last

## 
## Attaching package: 'PerformanceAnalytics'

## The following object is masked from 'package:graphics':
## 
##     legend

chart.Correlation(as.matrix(datos_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

##Podemos observar que la gran mayoria de correlacion son significativas al 1%

Pruebas de Barlet y KMO.

# Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_normalizados)

## R was not square, finding R from data

print(Barlett)

## $chisq
## [1] 1025.923
## 
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004695093
## 
## $df
## [1] 28

# Prueba de KMO
library(rela)
KMO <- paf(as.matrix(datos_normalizados))$KMO
print(KMO)

## [1] 0.67931

##KMO=0.67 indica una correlación moderada entre las variables, lo cual es adecuado, pero también indica que los datos podrían beneficiarse de una mejora en la selección de variables si fuera necesario. ##BARLETT= p-valor < 0.05: Se puede rechazar la hipótesis nula (H0), lo que significa que las variables sí tienen correlación significativa y, por lo tanto, el análisis factorial es apropiado.

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/ve3WBa

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_material_dark(html_font = "sans-serif") %>%
  kable_styling(bootstrap_options = c("hover"))

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

Gráfico de sedimentación

#Calcular la Matriz de Correlacion (version numerica)
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 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

Gráfico de sedimentación.

fviz_eig(
  PC,
  choice = "eigenvalue",
  barcolor = "darkblue",
  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)

##se puede observar que el punto de Quiebre ocurre en los primeros dos. Los criterios de extracción se mantienen entre 2 y 3 factores.

Variables representadas por factor

library(corrplot)

## Warning: package 'corrplot' was built under R version 4.4.1

## corrplot 0.95 loaded

#Modelo de 3 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

b) Las variables incluidas en cada factor.

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

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

## La dimensión 1, está más representada con X3, X4 y X8. La dimensión 2 está más representada con X1, X2 y X7. La dimensión 3 está más representada con X5 y X6.

Asignacion de los pesos a cada factor y variables dentro de cada uno de ellos.

##Extracción de ponderadores 

library(kableExtra)
cargas <- rotacion$loadings[1:8, 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_material_dark(html_font = "sans-serif") %>%
  kable_styling(bootstrap_options = c("hover"))

Ponderadores de los Factores Extraídos
Dim.1	Dim.2	Dim.3
0.44	0.31	0.25

print(ponderadores)

##   Dim.1   Dim.2   Dim.3 
## 0.44365 0.30532 0.25102

##Los pesos asignados en cada factor son: factor 1: peso de 0.44; factor 2: peso de 0.30; y factor 3: peso de 0.25.

Contribucion de las variables en los factores.

library(dplyr)
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("hover"))

Contribución de las variables en los Factores
	Dim.1	Dim.2	Dim.3
X1	0.01	0.31	0.00
X2	0.00	0.34	0.00
X3	0.29	0.00	0.05
X4	0.31	0.00	0.04
X5	0.06	0.00	0.38
X6	0.02	0.00	0.49
X7	0.00	0.33	0.00
X8	0.31	0.00	0.04

En el caso de las variables, los pesos para cada factor serán “Contribución de las variables en los Factores”

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

library(dplyr)

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

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

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

## # 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
## # ℹ 98 more rows

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

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

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

#Cálculo de la matriz de correlación

cor(data_factor_1)->mat_R_F1
print(mat_R_F1)

##          X3       X4       X8
## X3  1.00000 -0.93872  0.95904
## X4 -0.93872  1.00000 -0.99585
## X8  0.95904 -0.99585  1.00000

#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.48755 0.79129 0.42517

#Cálculo de los ponderadores netos
vj/sum(vj)->wj
print(wj)

##        S3      S4      S8
## 1 0.28612 0.46437 0.24951

#Ponderadores:
print(round(wj*100,2))

##      S3    S4    S8
## 1 28.61 46.44 24.95

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

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

##               X1         X2        X7
##   [1,] 0.0078125 0.00070734 0.0013986
##   [2,] 0.0086806 0.00212202 0.0076923
##   [3,] 0.0086806 0.00707339 0.0111888
##   [4,] 0.0069444 0.00106101 0.0244755
##   [5,] 0.0060764 0.00247569 0.0055944
##   [6,] 0.0052083 0.00459770 0.0174825
##   [7,] 0.0095486 0.00318302 0.0062937
##   [8,] 0.0078125 0.00106101 0.0041958
##   [9,] 0.0086806 0.00141468 0.0034965
##  [10,] 0.0104167 0.00212202 0.0041958
##  [11,] 0.0112847 0.00141468 0.0020979
##  [12,] 0.0095486 0.00070734 0.0062937
##  [13,] 0.0104167 0.00424403 0.0013986
##  [14,] 0.0147569 0.00141468 0.0027972
##  [15,] 0.0086806 0.00636605 0.0160839
##  [16,] 0.0104167 0.00070734 0.0048951
##  [17,] 0.0078125 0.00141468 0.0125874
##  [18,] 0.0060764 0.00247569 0.0125874
##  [19,] 0.0069444 0.00318302 0.0027972
##  [20,] 0.0095486 0.00282935 0.0153846
##  [21,] 0.0104167 0.00707339 0.0097902
##  [22,] 0.0095486 0.00565871 0.0013986
##  [23,] 0.0095486 0.00176835 0.0111888
##  [24,] 0.0060764 0.01061008 0.0209790
##  [25,] 0.0069444 0.00565871 0.0027972
##  [26,] 0.0086806 0.00636605 0.0048951
##  [27,] 0.0104167 0.00565871 0.0062937
##  [28,] 0.0052083 0.01061008 0.0111888
##  [29,] 0.0086806 0.06825818 0.0020979
##  [30,] 0.0095486 0.00141468 0.0069930
##  [31,] 0.0086806 0.00070734 0.0013986
##  [32,] 0.0043403 0.00141468 0.0027972
##  [33,] 0.0112847 0.01237843 0.0069930
##  [34,] 0.0069444 0.00141468 0.0055944
##  [35,] 0.0060764 0.00106101 0.0048951
##  [36,] 0.0190972 0.00813439 0.0076923
##  [37,] 0.0086806 0.00212202 0.0034965
##  [38,] 0.0078125 0.00353669 0.0090909
##  [39,] 0.0078125 0.01591512 0.0027972
##  [40,] 0.0078125 0.00282935 0.0013986
##  [41,] 0.0095486 0.00282935 0.0034965
##  [42,] 0.0095486 0.00353669 0.0076923
##  [43,] 0.0052083 0.00070734 0.0139860
##  [44,] 0.0112847 0.00176835 0.0034965
##  [45,] 0.0069444 0.04244032 0.0209790
##  [46,] 0.0069444 0.00070734 0.0013986
##  [47,] 0.0086806 0.00141468 0.0027972
##  [48,] 0.0060764 0.00106101 0.0020979
##  [49,] 0.0086806 0.00353669 0.0069930
##  [50,] 0.0086806 0.00389036 0.0027972
##  [51,] 0.0069444 0.00070734 0.0013986
##  [52,] 0.0052083 0.00389036 0.0076923
##  [53,] 0.0121528 0.00282935 0.0027972
##  [54,] 0.0052083 0.00070734 0.0062937
##  [55,] 0.0130208 0.00159151 0.0209790
##  [56,] 0.0095486 0.00106101 0.0020979
##  [57,] 0.0052083 0.00459770 0.0650350
##  [58,] 0.0182292 0.00070734 0.0041958
##  [59,] 0.0095486 0.00070734 0.0013986
##  [60,] 0.0104167 0.00176835 0.0048951
##  [61,] 0.0069444 0.00247569 0.0125874
##  [62,] 0.0295139 0.08311229 0.0650350
##  [63,] 0.0078125 0.00070734 0.0097902
##  [64,] 0.0104167 0.06825818 0.0440559
##  [65,] 0.0069444 0.00707339 0.0034965
##  [66,] 0.0104167 0.01061008 0.0020979
##  [67,] 0.0086806 0.06790451 0.0118881
##  [68,] 0.0086806 0.00459770 0.0209790
##  [69,] 0.0104167 0.00565871 0.0069930
##  [70,] 0.0052083 0.00070734 0.0111888
##  [71,] 0.0104167 0.01591512 0.0013986
##  [72,] 0.0086806 0.00318302 0.0195804
##  [73,] 0.0086806 0.00212202 0.0041958
##  [74,] 0.0078125 0.00070734 0.0013986
##  [75,] 0.0112847 0.00212202 0.0041958
##  [76,] 0.0086806 0.00212202 0.0020979
##  [77,] 0.0086806 0.06790451 0.0013986
##  [78,] 0.0086806 0.00247569 0.0041958
##  [79,] 0.0086806 0.00106101 0.0027972
##  [80,] 0.0069444 0.00636605 0.0125874
##  [81,] 0.0078125 0.01061008 0.0209790
##  [82,] 0.0295139 0.08311229 0.0650350
##  [83,] 0.0060764 0.06861185 0.0034965
##  [84,] 0.0095486 0.00070734 0.0013986
##  [85,] 0.0086806 0.00176835 0.0034965
##  [86,] 0.0060764 0.00070734 0.0013986
##  [87,] 0.0052083 0.00106101 0.0027972
##  [88,] 0.0130208 0.00176835 0.0062937
##  [89,] 0.0086806 0.00070734 0.0013986
##  [90,] 0.0138889 0.00212202 0.0069930
##  [91,] 0.0078125 0.00176835 0.0062937
##  [92,] 0.0043403 0.00141468 0.0013986
##  [93,] 0.0034722 0.00141468 0.0020979
##  [94,] 0.0121528 0.05057471 0.0027972
##  [95,] 0.0078125 0.00141468 0.0048951
##  [96,] 0.0199653 0.00247569 0.0048951
##  [97,] 0.0086806 0.00141468 0.0027972
##  [98,] 0.0078125 0.00247569 0.0048951
##  [99,] 0.0095486 0.00282935 0.0440559
## [100,] 0.0295139 0.08311229 0.0650350
## [101,] 0.0060764 0.00106101 0.0034965
## [102,] 0.0052083 0.00141468 0.0020979
## [103,] 0.0104167 0.00106101 0.0013986
## [104,] 0.0104167 0.00565871 0.0020979
## [105,] 0.0060764 0.00070734 0.0013986
## [106,] 0.0104167 0.00636605 0.0125874
## [107,] 0.0026042 0.00282935 0.0111888
## [108,] 0.0095486 0.00212202 0.0020979

#Fórmula de entropía
entropy<-function(x){
  return(x*log(x))
}
apply(data_normalizada,2,entropy)->data_normalizada_2
print(data_normalizada_2)

##               X1         X2        X7
##   [1,] -0.037906 -0.0051310 -0.009192
##   [2,] -0.041204 -0.0130618 -0.037443
##   [3,] -0.041204 -0.0350233 -0.050270
##   [4,] -0.034513 -0.0072664 -0.090806
##   [5,] -0.031010 -0.0148572 -0.029013
##   [6,] -0.027383 -0.0247457 -0.070744
##   [7,] -0.044414 -0.0183021 -0.031898
##   [8,] -0.037906 -0.0072664 -0.022966
##   [9,] -0.041204 -0.0092815 -0.019776
##  [10,] -0.047545 -0.0130618 -0.022966
##  [11,] -0.050604 -0.0092815 -0.012937
##  [12,] -0.044414 -0.0051310 -0.031898
##  [13,] -0.047545 -0.0231819 -0.009192
##  [14,] -0.062216 -0.0092815 -0.016445
##  [15,] -0.041204 -0.0321917 -0.066426
##  [16,] -0.047545 -0.0051310 -0.026040
##  [17,] -0.037906 -0.0092815 -0.055071
##  [18,] -0.031010 -0.0148572 -0.055071
##  [19,] -0.034513 -0.0183021 -0.016445
##  [20,] -0.044414 -0.0166018 -0.064221
##  [21,] -0.047545 -0.0350233 -0.045293
##  [22,] -0.044414 -0.0292813 -0.009192
##  [23,] -0.044414 -0.0112073 -0.050270
##  [24,] -0.031010 -0.0482329 -0.081068
##  [25,] -0.034513 -0.0292813 -0.016445
##  [26,] -0.041204 -0.0321917 -0.026040
##  [27,] -0.047545 -0.0292813 -0.031898
##  [28,] -0.027383 -0.0482329 -0.050270
##  [29,] -0.041204 -0.1832362 -0.012937
##  [30,] -0.044414 -0.0092815 -0.034705
##  [31,] -0.041204 -0.0051310 -0.009192
##  [32,] -0.023610 -0.0092815 -0.016445
##  [33,] -0.050604 -0.0543636 -0.034705
##  [34,] -0.034513 -0.0092815 -0.029013
##  [35,] -0.031010 -0.0072664 -0.026040
##  [36,] -0.075591 -0.0391399 -0.037443
##  [37,] -0.041204 -0.0130618 -0.019776
##  [38,] -0.037906 -0.0199631 -0.042732
##  [39,] -0.037906 -0.0658963 -0.016445
##  [40,] -0.037906 -0.0166018 -0.009192
##  [41,] -0.044414 -0.0166018 -0.019776
##  [42,] -0.044414 -0.0199631 -0.037443
##  [43,] -0.027383 -0.0051310 -0.059716
##  [44,] -0.050604 -0.0112073 -0.019776
##  [45,] -0.034513 -0.1340968 -0.081068
##  [46,] -0.034513 -0.0051310 -0.009192
##  [47,] -0.041204 -0.0092815 -0.016445
##  [48,] -0.031010 -0.0072664 -0.012937
##  [49,] -0.041204 -0.0199631 -0.034705
##  [50,] -0.041204 -0.0215886 -0.016445
##  [51,] -0.034513 -0.0051310 -0.009192
##  [52,] -0.027383 -0.0215886 -0.037443
##  [53,] -0.053596 -0.0166018 -0.016445
##  [54,] -0.027383 -0.0051310 -0.031898
##  [55,] -0.056526 -0.0102542 -0.081068
##  [56,] -0.044414 -0.0072664 -0.012937
##  [57,] -0.027383 -0.0247457 -0.177730
##  [58,] -0.073003 -0.0051310 -0.022966
##  [59,] -0.044414 -0.0051310 -0.009192
##  [60,] -0.047545 -0.0112073 -0.026040
##  [61,] -0.034513 -0.0148572 -0.055071
##  [62,] -0.103974 -0.2067470 -0.177730
##  [63,] -0.037906 -0.0051310 -0.045293
##  [64,] -0.047545 -0.1832362 -0.137556
##  [65,] -0.034513 -0.0350233 -0.019776
##  [66,] -0.047545 -0.0482329 -0.012937
##  [67,] -0.041204 -0.1826396 -0.052691
##  [68,] -0.041204 -0.0247457 -0.081068
##  [69,] -0.047545 -0.0292813 -0.034705
##  [70,] -0.027383 -0.0051310 -0.050270
##  [71,] -0.047545 -0.0658963 -0.009192
##  [72,] -0.041204 -0.0183021 -0.077014
##  [73,] -0.041204 -0.0130618 -0.022966
##  [74,] -0.037906 -0.0051310 -0.009192
##  [75,] -0.050604 -0.0130618 -0.022966
##  [76,] -0.041204 -0.0130618 -0.012937
##  [77,] -0.041204 -0.1826396 -0.009192
##  [78,] -0.041204 -0.0148572 -0.022966
##  [79,] -0.041204 -0.0072664 -0.016445
##  [80,] -0.034513 -0.0321917 -0.055071
##  [81,] -0.037906 -0.0482329 -0.081068
##  [82,] -0.103974 -0.2067470 -0.177730
##  [83,] -0.031010 -0.1838310 -0.019776
##  [84,] -0.044414 -0.0051310 -0.009192
##  [85,] -0.041204 -0.0112073 -0.019776
##  [86,] -0.031010 -0.0051310 -0.009192
##  [87,] -0.027383 -0.0072664 -0.016445
##  [88,] -0.056526 -0.0112073 -0.031898
##  [89,] -0.041204 -0.0051310 -0.009192
##  [90,] -0.059398 -0.0130618 -0.034705
##  [91,] -0.037906 -0.0112073 -0.031898
##  [92,] -0.023610 -0.0092815 -0.009192
##  [93,] -0.019663 -0.0092815 -0.012937
##  [94,] -0.053596 -0.1509303 -0.016445
##  [95,] -0.037906 -0.0092815 -0.026040
##  [96,] -0.078139 -0.0148572 -0.026040
##  [97,] -0.041204 -0.0092815 -0.016445
##  [98,] -0.037906 -0.0148572 -0.026040
##  [99,] -0.044414 -0.0166018 -0.137556
## [100,] -0.103974 -0.2067470 -0.177730
## [101,] -0.031010 -0.0072664 -0.019776
## [102,] -0.027383 -0.0092815 -0.012937
## [103,] -0.047545 -0.0072664 -0.009192
## [104,] -0.047545 -0.0292813 -0.012937
## [105,] -0.031010 -0.0051310 -0.009192
## [106,] -0.047545 -0.0321917 -0.055071
## [107,] -0.015496 -0.0166018 -0.050270
## [108,] -0.044414 -0.0130618 -0.012937

#Número de variables en el factor:
ncol(data_normalizada)->m

#Constante de entropía:
-1/log(m)->K
print(K)

## [1] -0.91024

#Cálculo de las entropías
K*colSums(data_normalizada_2)->Ej
print(Ej)

##     X1     X2     X7 
## 4.1805 3.2029 3.7019

#Cálculo de las especificidades:
1-Ej->vj
print(vj)

##      X1      X2      X7 
## -3.1805 -2.2029 -2.7019

#Cálculo de los ponderadores:
prop.table(vj)->wj #es igual a usar vj/sum(vj)
print(wj)

##      X1      X2      X7 
## 0.39337 0.27245 0.33417

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

Método de Ranking por suma

library(magrittr)

#Jerarquia
rj <- c(1,2)
names(rj) <- c("X5","X6")

#Función de pesos
rank_suma_ponderadores_subjetivos <- 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))
}
#Aplicación de función
ranking_suma_pesos <- rank_suma_ponderadores_subjetivos(rj)

#Pesos brutos
ranking_suma_pesos$w_brutos

## X5 X6 
##  2  1

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

##    X5    X6 
## 0.667 0.333

#Gráfico de pesos normalizados por suma
barplot(
  ranking_suma_pesos$w_normalizados,
  main = "Ponderadores Ranking de Suma",
  ylim = c(0, 0.5),
  col = "slateblue"
)

Metodo de Ranking reciprocos

#Jerarquia
rj <- c(1,2)
names(rj) <- c("X5","X6")

#Función de pesos
rank_reciproco_ponderadores_subjetivos <- function(vector_jerarquias) {
  vector_pesos <- 1 / vector_jerarquias
  list(w_brutos = vector_pesos,
       w_normalizados = vector_pesos / sum(vector_pesos))
}

#Aplicando la función
ranking_reciproco_pesos <- rank_reciproco_ponderadores_subjetivos(rj)

#Pesos brutos
ranking_reciproco_pesos$w_brutos

##  X5  X6 
## 1.0 0.5

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

##    X5    X6 
## 0.667 0.333

#Gráfico de jerarquia por reciprocos
barplot(
  ranking_reciproco_pesos$w_normalizados,
  main = "Ponderadores Ranking Recíproco",
  ylim = c(0, 0.5),
  col = "pink3"
)

Metodo de Ranking exponencial

#Jerarquia
rj <- c(1,2)
names(rj) <- c("X5","X6")

#Función de pesos
rank_exponencial_ponderadores_subjetivos <-
  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))
  }

#Aplicación de función
ranking_exponencial_pesos <-
  rank_exponencial_ponderadores_subjetivos(rj)

#Pesos brutos
ranking_exponencial_pesos$w_brutos

## X5 X6 
##  4  1

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

##  X5  X6 
## 0.8 0.2

#Gráfico de ranking exponencial
barplot(ranking_exponencial_pesos$w_normalizados,
        main = "Ponderadores Ranking Exponencial",
        ylim = c(0,0.5),col = "plum3")

#Comparación de valores de "p"

par(mfrow=c(1,3))
for(p in 2:4){
  
  pesos<-rank_exponencial_ponderadores_subjetivos(vector_jerarquias = rj,p = p)
  barplot(pesos$w_normalizados,main = paste0("p=",p),ylim = c(0,0.7),col = "lightpink4",cex.main=3,cex.axis = 3)
}

CLAVE B.

load("/Users/cesiayasmin/Downloads/data_parcial_2_B_rev.RData")

knitr::include_graphics("/Users/cesiayasmin/Downloads/imagen 1.jpeg")

Normalización de datos

library(dplyr)
norm_directa<-function(x){x - min(x, na.rm = TRUE)/(max(x, na.rm = TRUE) - min(x, na.rm = TRUE))}
norm_inversa<-function(x){(max(x, na.rm = TRUE) - x)/(max(x, na.rm = TRUE) - min(x, na.rm = TRUE))}
# Variables con correlación 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_corr_positiva
# Variables con correlación negativa
data_parcial_2 %>% 
  select(MORTINF,TASA_MOR) %>% 
  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(ALFABET,INC_POB, ESPVIDAF, MORTINF, FERTILID, TASA_NAT, LOG_PIB, URBANA, TASA_MOR  )->datos_desarollo_normalizados
head(datos_desarollo_normalizados)

##   ALFABET INC_POB ESPVIDAF MORTINF FERTILID TASA_NAT LOG_PIB URBANA TASA_MOR
## 1   97.78 1.45415   73.897 0.81098   2.6113   22.767  2.5637 53.947 0.772727
## 2   28.78 2.85415   42.897 0.00000   6.7113   52.767  1.3984 17.947 0.090909
## 3   98.78 0.41415   77.897 0.98476   1.2813   10.767  3.3306 84.947 0.590909
## 4   61.78 3.25415   68.897 0.70732   6.4813   37.767  2.9095 76.947 0.818182
## 5   94.78 1.35415   73.897 0.86829   2.6113   19.767  2.6191 85.947 0.681818
## 6   97.78 1.45415   73.897 0.85976   3.0013   22.767  2.7856 67.947 0.818182

** Matriz de Correlación Y Pruebas de Barlett y KMO

#Matriz de correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_desarollo_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

#KMO
library(rela)
KMO<-paf(as.matrix(datos_desarollo_normalizados))$KMO
print(KMO)

## [1] 0.86467

El Resultado de la prueba KMO es cerca a 1 por lo tanto podemos tener confianza en que los datos son adecuados para el análisis factorial.

#Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_desarollo_normalizados)

## R was not square, finding R from data

print(Barlett)

## $chisq
## [1] 1596.2
## 
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000014916
## 
## $df
## [1] 36

##Se rechaza la H0, es decir, los datos no son independientes entre sí y por tanto es necesario el análisis factorial.

Análisis Factorial

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

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

datos_desarollo_sin_na <- datos_desarollo_normalizados[complete.cases(datos_desarollo_normalizados), ]

Rx<-cor(datos_desarollo_sin_na)
PC<-princomp(x = datos_desarollo_sin_na,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.69	74.34	74.34
Dim.2	1.24	13.83	88.18
Dim.3	0.53	5.91	94.08
Dim.4	0.20	2.20	96.28
Dim.5	0.17	1.93	98.21
Dim.6	0.07	0.73	98.94
Dim.7	0.06	0.62	99.56
Dim.8	0.03	0.28	99.84
Dim.9	0.01	0.16	100.00

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

1.2 ¿Qué variables quedan representadas en cada factor?

library(corrplot)
#Modelo de 2 Factores (Rotada)
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.76  0.53 0.86 0.141 1.8
## INC_POB  -0.98  0.05 0.96 0.042 1.0
## ESPVIDAF  0.62  0.76 0.96 0.036 1.9
## MORTINF   0.66  0.71 0.94 0.059 2.0
## FERTILID -0.87 -0.40 0.92 0.079 1.4
## TASA_NAT -0.90 -0.40 0.97 0.034 1.4
## LOG_PIB   0.65  0.58 0.75 0.246 2.0
## URBANA    0.42  0.73 0.71 0.294 1.6
## TASA_MOR -0.02  0.93 0.87 0.135 1.0
## 
##                        RC1  RC2
## SS loadings           4.52 3.41
## Proportion Var        0.50 0.38
## Cumulative Var        0.50 0.88
## 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 = 1

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="pink",
         number.cex = 0.75)

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

Ponderadores de los Factores Extraídos
Dim.1	Dim.2
0.57	0.43

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

contribuciones<-apply(cargas^2,MARGIN = 2,prop.table)
contribuciones %>% kable(caption="Contribución de las variables en los Factores",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Contribución de las variables en los Factores
	Dim.1	Dim.2
ALFABET	0.13	0.08
INC_POB	0.21	0.00
ESPVIDAF	0.09	0.17
MORTINF	0.10	0.15
FERTILID	0.17	0.05
TASA_NAT	0.18	0.05
LOG_PIB	0.09	0.10
URBANA	0.04	0.16
TASA_MOR	0.00	0.25

knitr::include_graphics("/Users/cesiayasmin/Downloads/imagen 2.jpeg")

knitr::include_graphics("/Users/cesiayasmin/Downloads/imagen 3.jpeg")

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 = "darkblue")

#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 = "cyan4")

#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

Grafico

#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 = "darkmagenta")

Comparación por pares, calcule los pesos normalizados para cada variables:

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

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

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

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

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

barplot(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.075207

sum(promedio_tot)

## [1] 1

normalizacion_1<-promedio_tot/sum(promedio_tot)
show(normalizacion_1)

##     w_X1     w_X2     w_X3     w_X4 
## 0.610848 0.198207 0.115739 0.075207

##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)+(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.074838

sum(ponderacion_expertos_distintas)

## [1] 1

normalizacion_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

A21_21033

CESIA YASMIN LEON REYES

2024-10-26

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:

Ejercicio 1.

Pruebas de Barlet y KMO.

Analisis Factorial.

Gráfico de sedimentación

Gráfico de sedimentación.

Variables representadas por factor

b) Las variables incluidas en cada factor.

Asignacion de los pesos a cada factor y variables dentro de cada uno de ellos.

Contribucion de las variables en los factores.

En el caso de las variables, los pesos para cada factor serán “Contribución de las variables en los Factores”

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

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

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

Método de Ranking por suma

Metodo de Ranking reciprocos

Metodo de Ranking exponencial

Normalización de datos

Análisis Factorial

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

1.2 ¿Qué variables quedan representadas en cada factor?

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

Grafico

Grafico

Comparación por pares, calcule los pesos normalizados para cada variables:

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