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)

creando data

data_ejercicio<-data.frame(datos_ejercicio)

Solución Rotada

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

Quedan dentro del factor 1: X3, X7 y X8

Método CRITIC

Normalización de datos y cálculos

#Funciones para normalizar 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_ejercicio
print(data_ejercicio)
## # 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

##_____________________________________________________________________

library(dplyr)
ponderadores_criticos<-function(x){
#Funciones para normalizar 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))
sd_2<- apply(data_ejercicio,2,sd)
cor_2<-cor(data_ejercicio)
sum_2<-1-cor_2
sum_vec_2<-colSums(sum_2)
ponderador_bruto<- sd_2*sum_vec_2
ponderador_neto<-ponderador_bruto/sum(ponderador_bruto)
list(normalizados=data_ejercicio,desviacion=sd_2,correlacion=cor_2,ponderador_b=ponderador_bruto,ponderador_n=ponderador_neto)}
print(ponderadores_criticos())
## $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    
## 
## $desviacion
##        X3        X7        X8 
## 0.3179355 0.3108151 0.3124976 
## 
## $correlacion
##            X3         X7         X8
## X3  1.0000000  0.7060802 -0.7251117
## X7  0.7060802  1.0000000 -0.9346464
## X8 -0.7251117 -0.9346464  1.0000000
## 
## $ponderador_b
##        X3        X7        X8 
## 0.6419218 0.6926720 1.1436656 
## 
## $ponderador_n
##        X3        X7        X8 
## 0.2590212 0.2794994 0.4614794

Método de Entropía

library(dplyr)
ponderadores_entropia<-function(x){
#Normalización de los datos
  library(dplyr)
datos_ejercicio %>% dplyr::select(X3,X7,X8)->data_ejercicio
apply(data_ejercicio,2,prop.table)->data_ejercicio

#Fórmula de entropía
entropy<-function(x){
  return(x*log(x))
}
apply(data_ejercicio,2,entropy)->data_ejercicio
ncol(data_ejercicio)->m
-1/log(m)->K
K*colSums(data_ejercicio)->Ej
1-Ej->vj
prop.table(vj)->wj
list(variables=m,constante_entropia=K,calculos_entropia=Ej,calculo_especifidades=vj,calculo_donderadores=wj)
}

print(ponderadores_entropia())
## $variables
## [1] 3
## 
## $constante_entropia
## [1] -0.9102392
## 
## $calculos_entropia
##       X3       X7       X8 
## 2.506828 2.299572 2.203352 
## 
## $calculo_especifidades
##        X3        X7        X8 
## -1.506828 -1.299572 -1.203352 
## 
## $calculo_donderadores
##        X3        X7        X8 
## 0.3757909 0.3241028 0.3001063