Métodos de ponderación de variables CRITIC y Entropía: Funciones

Integrantes

Método CRITIC

#Carga de datos
library(readr)
datos_ejercicio <- read_table2("http://halweb.uc3m.es/esp/Personal/personas/agrane/libro/ficheros_datos/capitulo_7/datos_prob_7_3.txt",col_names = FALSE)

1era Función: Normalización

library(dplyr)
#Generando la función para normalizar datos 
norm_directa<- function(x){
return((x-min(x)) / (max(x)-min(x)))}
norm_inversa<- function(x){
return((max(x)-x) / (max(x)-min(x)))}
#Normalizando datos 
library(dplyr)
data_factor<- datos_ejercicio %>% dplyr::select(X3,X7,X8) %>%       dplyr::transmute(X3=norm_directa(X3),X7=norm_directa(X7), X8=norm_inversa(X8))
#Omitiendo Valores Nulos
data_factor_omit <- na.omit(data_factor)
print(data_factor_omit)
## # A tibble: 18 x 3
##        X3      X7    X8
##     <dbl>   <dbl> <dbl>
##  1 0.983  0.768   0.353
##  2 0.55   0.165   0.765
##  3 0.483  0       1    
##  4 1      0.744   0.118
##  5 0.0333 0.00478 1    
##  6 0.517  0.175   0.941
##  7 0.283  0.0215  1    
##  8 0.867  0.440   0.706
##  9 0.333  0.215   0.941
## 10 0      0.0478  1    
## 11 0.2    0.0191  1    
## 12 0.5    0.670   0.706
## 13 0.867  0.184   0.824
## 14 0.3    0.110   1    
## 15 0.0667 0.0335  1    
## 16 0.3    0.445   0.647
## 17 0.533  0.309   0.882
## 18 0.767  1       0

Encontrando las desviaciones estándar

sd_data<-apply(data_factor_omit,2,sd)
print(sd_data)
##        X3        X7        X8 
## 0.3179355 0.3108151 0.3124976

2da Función: Ponderadores por el Método CRITIC

pond_metd_critic<-function(datos_ejercicio){

 
#Obteniendo la matriz de correlación
cor_data<-cor(data_factor_omit)
  
#Calculando los ponderadores brutos
sum_data<-1-cor_data
sum_vec<-colSums(sum_data)  
pond_br<-sd_data*sum_vec
  
#Calculando los ponderadores netos
pond_neto<- pond_br/sum(pond_br)
  
#Mostrar como lista
list(normalizados=data_factor_omit, desv=sd_data, corr=cor_data, w_brutos=pond_br,
       w_netos=pond_neto)

}

Aplicando la segunda función: método CRITIC

metd_critic<- pond_metd_critic(datos_ejercicio)
metd_critic
## $normalizados
## # A tibble: 18 x 3
##        X3      X7    X8
##     <dbl>   <dbl> <dbl>
##  1 0.983  0.768   0.353
##  2 0.55   0.165   0.765
##  3 0.483  0       1    
##  4 1      0.744   0.118
##  5 0.0333 0.00478 1    
##  6 0.517  0.175   0.941
##  7 0.283  0.0215  1    
##  8 0.867  0.440   0.706
##  9 0.333  0.215   0.941
## 10 0      0.0478  1    
## 11 0.2    0.0191  1    
## 12 0.5    0.670   0.706
## 13 0.867  0.184   0.824
## 14 0.3    0.110   1    
## 15 0.0667 0.0335  1    
## 16 0.3    0.445   0.647
## 17 0.533  0.309   0.882
## 18 0.767  1       0    
## 
## $desv
##        X3        X7        X8 
## 0.3179355 0.3108151 0.3124976 
## 
## $corr
##            X3         X7         X8
## X3  1.0000000  0.7060802 -0.7251117
## X7  0.7060802  1.0000000 -0.9346464
## X8 -0.7251117 -0.9346464  1.0000000
## 
## $w_brutos
##        X3        X7        X8 
## 0.6419218 0.6926720 1.1436656 
## 
## $w_netos
##        X3        X7        X8 
## 0.2590212 0.2794994 0.4614794

Método de Entropía

Normalización de Entropía

library(dplyr)
e_data_norm <- datos_ejercicio %>% dplyr::select(X3,X7,X8)
e_data_norm1 <- apply(e_data_norm,2,prop.table)
#Omitiendo Valores Nulos
e_data_norm1_omit <- na.omit(e_data_norm1)
print(e_data_norm1_omit)
##               X3          X7         X8
##  [1,] 0.10166920 0.131305352 0.13636364
##  [2,] 0.06221548 0.034270312 0.05681818
##  [3,] 0.05614568 0.007701194 0.01136364
##  [4,] 0.10318665 0.127454755 0.18181818
##  [5,] 0.01517451 0.008471313 0.01136364
##  [6,] 0.05918058 0.035810551 0.02272727
##  [7,] 0.03793627 0.011166731 0.01136364
##  [8,] 0.09104704 0.078552176 0.06818182
##  [9,] 0.04248862 0.042356565 0.02272727
## [10,] 0.01213961 0.015402387 0.01136364
## [11,] 0.03034901 0.010781671 0.01136364
## [12,] 0.05766313 0.115517905 0.06818182
## [13,] 0.09104704 0.037350789 0.04545455
## [14,] 0.03945372 0.025413939 0.01136364
## [15,] 0.01820941 0.013092029 0.01136364
## [16,] 0.03945372 0.079322295 0.07954545
## [17,] 0.06069803 0.057373893 0.03409091
## [18,] 0.08194234 0.168656142 0.20454545

2nda Función: Fórmula de Entropia

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

Entropía en datos normalizados

norm_entropy<-apply(e_data_norm1_omit,2,entropy)
print(norm_entropy)
##                X3          X7          X8
##  [1,] -0.23241892 -0.26658003 -0.27169502
##  [2,] -0.17278181 -0.11561007 -0.16294880
##  [3,] -0.16168863 -0.03747693 -0.05087883
##  [4,] -0.23435914 -0.26255601 -0.30995420
##  [5,] -0.06355294 -0.04041723 -0.05087883
##  [6,] -0.16731307 -0.11923168 -0.08600431
##  [7,] -0.12412169 -0.05019240 -0.05087883
##  [8,] -0.21818321 -0.19983612 -0.18310755
##  [9,] -0.13420111 -0.13391587 -0.08600431
## [10,] -0.05355122 -0.06427775 -0.05087883
## [11,] -0.10606954 -0.04883998 -0.05087883
## [12,] -0.16452082 -0.24932573 -0.18310755
## [13,] -0.21818321 -0.12278703 -0.14050193
## [14,] -0.12753915 -0.09333161 -0.05087883
## [15,] -0.07294355 -0.05676379 -0.05087883
## [16,] -0.12753915 -0.20102142 -0.20136348
## [17,] -0.17006641 -0.16398410 -0.11518379
## [18,] -0.20499838 -0.30018994 -0.32460649
#Generando la función para obtener los ponderadores por el Método Entropía 
pond_entropia<-function(datos_ejercicio) {
  
#Número de variables en el factor
m<- nrow(e_data_norm1_omit)
  
#Constante
K<- -1/log(m)
  
#Calculando las entropías
Ej<-K*rowSums(norm_entropy)
  
##Calculando las especificidades
Vj<-1-Ej
  
#Calculando los ponderadores
Wj<-Vj/sum(Vj)
  
#Mostrar como lista
list(normalizados=e_data_norm1_omit, kentropia=K, entropias=Ej, especificidades=Vj, 
       ponderadores=Wj)
  }

Aplicando la función: método de Entropía

metd_entr<-pond_entropia(datos_ejercicio)
metd_entr
## $normalizados
##               X3          X7         X8
##  [1,] 0.10166920 0.131305352 0.13636364
##  [2,] 0.06221548 0.034270312 0.05681818
##  [3,] 0.05614568 0.007701194 0.01136364
##  [4,] 0.10318665 0.127454755 0.18181818
##  [5,] 0.01517451 0.008471313 0.01136364
##  [6,] 0.05918058 0.035810551 0.02272727
##  [7,] 0.03793627 0.011166731 0.01136364
##  [8,] 0.09104704 0.078552176 0.06818182
##  [9,] 0.04248862 0.042356565 0.02272727
## [10,] 0.01213961 0.015402387 0.01136364
## [11,] 0.03034901 0.010781671 0.01136364
## [12,] 0.05766313 0.115517905 0.06818182
## [13,] 0.09104704 0.037350789 0.04545455
## [14,] 0.03945372 0.025413939 0.01136364
## [15,] 0.01820941 0.013092029 0.01136364
## [16,] 0.03945372 0.079322295 0.07954545
## [17,] 0.06069803 0.057373893 0.03409091
## [18,] 0.08194234 0.168656142 0.20454545
## 
## $kentropia
## [1] -0.3459763
## 
## $entropias
##  [1] 0.26664182 0.15615316 0.08650942 0.27915764 0.05357407 0.12889313
##  [7] 0.07791140 0.20797563 0.12251756 0.05836889 0.07119788 0.20653194
## [13] 0.16657794 0.09401891 0.06247853 0.18334114 0.15542440 0.28708930
## 
## $especificidades
##  [1] 0.7333582 0.8438468 0.9134906 0.7208424 0.9464259 0.8711069 0.9220886
##  [8] 0.7920244 0.8774824 0.9416311 0.9288021 0.7934681 0.8334221 0.9059811
## [15] 0.9375215 0.8166589 0.8445756 0.7129107
## 
## $ponderadores
##  [1] 0.04782052 0.05502522 0.05956652 0.04700440 0.06171416 0.05680278
##  [7] 0.06012718 0.05164600 0.05721852 0.06140150 0.06056495 0.05174014
## [13] 0.05434545 0.05907685 0.06113352 0.05325236 0.05507274 0.04648719