Metodos de Ponderación CRITIC y entropia

Trabajo Presentado por:

Nombres	Carnet	Grupo_Teorico
Rodrigo Alejandro Roque Soto	RS18005	2
Mario Antonio Herrera Rivera	HR17038	2

Importación de Datos y Solución Rotada

library(dplyr)
library(readr)
library(kableExtra)
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)
datos_ejercicio %>% dplyr::select(X3,X7,X8)->data_normal

# Solución Rotada
library(psych)
modelo_4<-principal(r = datos_ejercicio,nfactors = 4,covar = FALSE,rotate = "varimax")
modelo_4$loadings

## 
## Loadings:
##    RC1    RC2    RC4    RC3   
## X1 -0.218 -0.102 -0.900 -0.143
## X2 -0.118 -0.937 -0.163  0.179
## X3  0.761         0.447       
## X4  0.216         0.113  0.960
## X5  0.382  0.366  0.715       
## X6         0.951  0.118       
## X7  0.877  0.152  0.287  0.269
## X8  0.971                0.121
## 
##                  RC1   RC2   RC4   RC3
## SS loadings    2.549 1.954 1.667 1.071
## Proportion Var 0.319 0.244 0.208 0.134
## Cumulative Var 0.319 0.563 0.771 0.905

Función Método CRITIC

Normalización de Datos

# Normalizando 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)))
}
datos_ejercicio %>% dplyr::select(X3,X7,X8) %>% dplyr::transmute(X3=norm_directa(X3),X7=norm_directa(X7), X8=norm_inverza(X8)) ->data_factor_1

Método CRITIC

funcion_critic <- function(data_ejercicio) {
  
# Desviación Típica
  desviacion <- apply(data_ejercicio,MARGIN = 2,FUN = sd)
  
# Matriz de Correlación
    coeficiente_correlacion<-cor(data_ejercicio)
    
# Ponderadores Brutos    
1-coeficiente_correlacion->sum_data 
colSums(sum_data)->sum_vector 
desviacion * sum_vector->vj

# Ponderadores netos
   wj <- vj/sum(vj)
   
# Ponderadores    
   ponderadores<-round(wj*100,2)
   
# Resultados en lista
list(Desviacion_Estandar=desviacion,Ponderadores_Brutos=vj,Ponderadores_Netos=wj,Ponderadores=ponderadores)
}

# Probando la Función
salida_critic<-funcion_critic(data_factor_1)
salida_critic %>% as.data.frame() %>% kable(caption = "Prueba Función Critic",align = "c",digits = 4) %>% kable_minimal(html_font = "helvetica") %>% kable_styling(bootstrap_options = c("striped","hover"))

Prueba Función Critic

	Desviacion_Estandar	Ponderadores_Brutos	Ponderadores_Netos	Ponderadores
X3	0.3179	0.6419	0.2590	25.90
X7	0.3108	0.6927	0.2795	27.95
X8	0.3125	1.1437	0.4615	46.15

Función Método Entropía

Normalización de Datos

# Normalizando los datos función entropía
  data_norm<-datos_ejercicio %>% dplyr::select(X3,X7,X8)
  data_norm<-apply(data_norm,2,prop.table)
  data_norm<-na.omit(data_norm)
head(data_norm,n = 10)

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

Método Entropía

funcion_entropy<-function(data_ejercicio){
  
#Fórmula de entropía
entropy<-function(x){
  return(x*log(x))}

# Usando formula de entropía
data_norm2<-apply(data_ejercicio,2,entropy)

# Número de observaciones
m<-nrow(data_norm2)

# Constante de Entropía
K<--1/log(m)

# Cálculos de las Entropías
Ej<-K*colSums(data_norm2)

#Cálculo de las Especificidades
vj<-1-Ej

# Cálculo de los Ponderadores
wj<- vj/sum(vj)
ponderadores<-round(wj*100,2)

# Resultados en Lista
list(Constante=K,Entropias=Ej,Especificidades=vj,Ponderadores=ponderadores)
}

# Probando la Función
salida_entropia<-funcion_entropy(data_norm)
salida_entropia %>% as.data.frame() %>% kable(caption = "Prueba de la Función entropia",align = "c",digits = 4) %>% kable_minimal(html_font = "helvetica") %>% kable_styling(bootstrap_options = c("striped","hover"))

Prueba de la Función entropia

	Constante	Entropias	Especificidades	Ponderadores
X3	-0.346	0.9528	0.0472	14.05
X7	-0.346	0.8741	0.1259	37.52
X8	-0.346	0.8375	0.1625	48.42