PRACTICA UNIDAD 2 CLAVE A

#CLAVE A

Se necesita construir un indicador multivariado sintético, que mida la “Seguridad Municipal” Para ello se dispone de la siguiente información:

Variable y 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

#CARGA DE DATOS

load("C:/doc R/GUIAS/PRACTICA_U2/data_parcial_2_A_rev.RData")

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

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

###Normalización de los datos

library(dplyr)
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 correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_normalizados),
                  histogram = TRUE,
                  pch = 12)

###Verificación de supuestos: Prueba de Barlett y KMO

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

## [1] 0.67931

#Prueba Barlett
library(psych)
Barlett <- cortest.bartlett(datos_normalizados)

## R was not square, finding R from data

print(Barlett)

## $chisq
## [1] 1025.9
## 
## $p.value
## [1] 4.6951e-198
## 
## $df
## [1] 28

• KMO = 0.67: el valor minimo para considerar aceptable el analisis factorial es de 0.5, por lo que nuestros datos son adecuados y podemos seguir con el análisis.

• De la prueba Barlett, podemos determinar que la H0 se rechaza, esto porque el p.value<0.05. Entonces decimos que existe correlacion entre la bateria de indicadores. Podemos realizar un analisis factorial.

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

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

• el punto de quiebre se da en los primeros dos componentes, y tomando en cuenta los datos del resumen de PCA, el criterio de extracción se mantienen entre 2 y 3 factores.

###Variables representadas por factor

library(corrplot)

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

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

• 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 a ser 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

• Para 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 x 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

#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 x 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)
}