func. crit. & entrop.

-carga de los datos y solución rotada

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)

-Normalización de datos y cálculo

-Método Crític

#Funciones para la normalización de los datos 
norm_directa <- function(x){
  return((x-min(x)) / (max(x)-min(x)))
}
norm_inverza <- function(x){
  return((max(x)-x) / (max(x)-min(x)))
}
#Normalización de los datos 
library(dplyr)
datos_ejercicio %>% dplyr::select(X3,X7,X8) %>% dplyr::transmute(X3=norm_directa(X3), X7=norm_directa(X7), X8=norm_inverza(X8))->data_factor_1
print(data_factor_1)

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

-Función para el método Crític

# función para los ponderadores
funcion_ponderadores_critic<-function(data_factor_1){
  apply(data_factor_1,2,sd)->vector_sd           #vector de desviaciones estandar
  cor(data_factor_1)->matriz_R                   #matriz de correlación
  1-matriz_R->sum_data                           
  colSums(sum_data)->sum_vector                  #Factor de correlación residual
  vector_sd*sum_vector->vj                       #Ponderadores Brutos
  list(Desviacion_estandar=vector_sd,matrizde_correlacion=matriz_R,FactorCorrelacionResidual=sum_vector,ponderadores_brutos=vj,ponderadores_netos=vj/sum(vj),ponderadores_porcentuales=((vj/sum(vj))*100))
}

# Probando la función

metodo_critic<-funcion_ponderadores_critic(data_factor_1)

• Variable donde se aplicará la función

metodo_critic$ponderadores_netos

##        X3        X7        X8 
## 0.2590212 0.2794994 0.4614794

-Método Entropía

# Normalización de los datos
library(dplyr)
datos_ejercicio %>% dplyr::select(X3,X7,X8)->data_norm
apply(data_norm,2,prop.table)->data_norm
print(data_norm)

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

# Función para los ponderadores
funcion_ponderadores_entropia<- function(data_norm){
  data_norm*log(data_norm)->entropia
  nrow(data_norm)->m                 #Obtener el valor m, cuenta el No. de observaciones.
  -1/log(m)->K                       #K, Constante de entropia.
  K*colSums(entropia)->Ej            #Calculo de entropias.
  1-Ej->vj                           #Especificidades.
  prop.table(vj)->wj                 #ponderadores.
  list(entropia=entropia,num_observaciones=m,const_entropia=K,entropias=Ej,especificidades=vj,ponderadores=wj)
}

# Probando la Función

metodo_entropia<-funcion_ponderadores_entropia(data_norm)

• Variable donde se aplicara la función

metodo_entropia$especificidades

##         X3         X7         X8 
## 0.04717033 0.12594714 0.16251976