Funciones CRITIC y Entropía

Integrantes:

AB16003. Alexander Daniel Alvarez Berardi.

JA13009. Rosa Katya Jovel Barahona.

PO16004. Silvia Raquel Paz Ortiz.

PG15036. Rene Ernesto Pereira Garcia.

CL12025. Jose Manuel Canales Lopez.

CARGA DE DATOS

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

Solucion rotada

library(psych)
modelo_4<-principal(r = datos_ejercicio_propio,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

Quedan dentro del factor 1: X3, X7 y X8

Función método CRITIC

Primer paso. Seleccionar datos y normalizarlos.

library(dplyr)
#Formula de normalización

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

#Normalización
data_factor <- datos_ejercicio_propio %>% select(X3, X7, X8) %>% 
    transmute(X3=norm_directa(X3), X7= norm_directa(X7), X8= norm_inversa(X8))

Función de ponderadores CRITIC

library(dplyr)
formula_critic<- function(data_factor){
  #Desviacion estandar
  desviacion_estandar <- apply(data_factor,2, sd) 
  
  #Matriz correlacion
  matriz_r <-cor(data_factor)
  print(matriz_r)
  
  #Ponderador bruto
  suma_data<-1-matriz_r
  sum_vector<-colSums(suma_data)
  
  ponderadores_brutos<- desviacion_estandar*sum_vector
  
  #Ponderador neto
  ponderadores_netos<-round((ponderadores_brutos/sum(ponderadores_brutos))*100,2)
  
  
  return(list("Vector desviaciones"=round(desviacion_estandar,4),
              "Ponderadores brutos"=ponderadores_brutos,
              "Ponderadores netos"=ponderadores_netos))
}

Probando

library(readr)
library(dplyr)
library(kableExtra)
CRITIC <- formula_critic(data_factor)

##            X3         X7         X8
## X3  1.0000000  0.7060802 -0.7251117
## X7  0.7060802  1.0000000 -0.9346464
## X8 -0.7251117 -0.9346464  1.0000000

CRITIC %>% as.data.frame() %>% 
  kable(caption ="Resultados para el método Crític" ,align = "c",digits = 4) %>% 
  kable_classic_2(html_font = "Sans-serif") %>% kable_styling(font_size = 16, bootstrap_options = c("striped", "hover"))

Resultados para el método Crític

	Vector.desviaciones	Ponderadores.brutos	Ponderadores.netos
X3	0.3179	0.6419	25.90
X7	0.3108	0.6927	27.95
X8	0.3125	1.1437	46.15

Función método de entropía

Primer paso. Seleccionar datos y normalizarlos.

library(dplyr)
datos_ejercicio_propio %>% select(X3,X7,X8)->data_norm
apply(data_norm,2,prop.table)->data_norm
data_norm <- (data_norm) +2
print(data_norm)

##             X3       X7       X8
##  [1,] 2.101669 2.131305 2.136364
##  [2,] 2.062215 2.034270 2.056818
##  [3,] 2.056146 2.007701 2.011364
##  [4,] 2.103187 2.127455 2.181818
##  [5,] 2.015175 2.008471 2.011364
##  [6,] 2.059181 2.035811 2.022727
##  [7,] 2.037936 2.011167 2.011364
##  [8,] 2.091047 2.078552 2.068182
##  [9,] 2.042489 2.042357 2.022727
## [10,] 2.012140 2.015402 2.011364
## [11,] 2.030349 2.010782 2.011364
## [12,] 2.057663 2.115518 2.068182
## [13,] 2.091047 2.037351 2.045455
## [14,] 2.039454 2.025414 2.011364
## [15,] 2.018209 2.013092 2.011364
## [16,] 2.039454 2.079322 2.079545
## [17,] 2.060698 2.057374 2.034091
## [18,] 2.081942 2.168656 2.204545

Función de ponderadores ENTROPIA

library(dplyr)
entropia<-function(x){
  return(x*log(x))
}

#Formula ENTROPIA
formula_entropia <-function(data_norm){
normalizacion_entropia<- apply(X = data_norm, MARGIN = 2, FUN = entropia)
print(normalizacion_entropia)

#Numero de variables
m<-nrow(normalizacion_entropia)

#Constante de entropia
k<- -1/log(m)

#Calculo de entropias
ej<- k*colSums(normalizacion_entropia)

#Calculo de especificidades
vj<- 1-ej

#Calculo de ponderadores
wj<-round((prop.table(vj))*100,2)

return(list("Constante de entropía"= k,
            "Entropías"=ej,
            "Especificidades"=vj,
            "Ponderadores"=wj))
}

Probando

library(readr)
library(dplyr)
library(kableExtra)
ENTROPIA <- formula_entropia(data_norm)

##             X3       X7       X8
##  [1,] 1.560977 1.612833 1.621725
##  [2,] 1.492592 1.444611 1.483295
##  [3,] 1.482138 1.399348 1.405567
##  [4,] 1.563622 1.606072 1.702164
##  [5,] 1.412044 1.400655 1.405567
##  [6,] 1.487363 1.447246 1.424904
##  [7,] 1.450884 1.405232 1.405567
##  [8,] 1.542492 1.520818 1.502885
##  [9,] 1.458682 1.458456 1.424904
## [10,] 1.406885 1.412432 1.405567
## [11,] 1.437909 1.404578 1.405567
## [12,] 1.484750 1.585157 1.502885
## [13,] 1.542492 1.449881 1.463768
## [14,] 1.453482 1.429485 1.405567
## [15,] 1.417208 1.408504 1.405567
## [16,] 1.453482 1.522151 1.522538
## [17,] 1.489977 1.484252 1.444304
## [18,] 1.526691 1.678773 1.742740

ENTROPIA %>% as.data.frame() %>% 
  kable(caption ="Resultados para el método de entropía" ,align = "c",digits = 4) %>% 
  kable_classic_2(html_font = "Sans-serif") %>% kable_styling(font_size = 16, bootstrap_options = c("striped", "hover"))

Resultados para el método de entropía

	Constante.de.entropía	Entropías	Especificidades	Ponderadores
X3	-0.346	-9.2250	10.2250	33.33
X7	-0.346	-9.2274	10.2274	33.33
X8	-0.346	-9.2289	10.2289	33.34