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)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.905Quedan dentro del factor 1: X3, X7 y X8
#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_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#Cálculo de las desviaciones estándar de cada variable
data_factor_1 %>% dplyr::summarise(S3=sd(X3),S7=sd(X7),S8=sd(X8))-> sd_vector
print(sd_vector)## # A tibble: 1 x 3
## S3 S7 S8
## <dbl> <dbl> <dbl>
## 1 0.318 0.311 0.312#Cálculo de la matriz de correlación
cor(data_factor_1)->mat_R_F1
print(mat_R_F1)## X3 X7 X8
## X3 1.0000000 0.7060802 -0.7251117
## X7 0.7060802 1.0000000 -0.9346464
## X8 -0.7251117 -0.9346464 1.0000000#Cálculo de los ponderadores brutos
1-mat_R_F1->sum_data
colSums(sum_data)->sum_vector
sd_vector*sum_vector->vj
print(vj)## S3 S7 S8
## 1 0.6419218 0.692672 1.143666#Cálculo de los ponderadores netos
vj/sum(vj)->wj
print(wj)## S3 S7 S8
## 1 0.2590212 0.2794994 0.4614794#Ponderadores:
print(round(wj*100,2))## S3 S7 S8
## 1 25.9 27.95 46.15#Normalización de los datos
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#Fórmula de entropía
entropy<-function(x){
return(x*log(x))
}
apply(data_norm,2,entropy)->data_norm_2
print(data_norm_2)## 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#Número de variables en el factor:
ncol(data_norm)->m
#Constante de entropía:
-1/log(m)->K
print(K)## [1] -0.9102392#Cálculo de las entropías
K*colSums(data_norm_2)->Ej
print(Ej)## X3 X7 X8
## 2.506828 2.299572 2.203352#Cálculo de las especificidades:
1-Ej->vj
print(vj)## X3 X7 X8
## -1.506828 -1.299572 -1.203352#Cálculo de los ponderadores:
prop.table(vj)->wj #es igual a usar vj/sum(vj)
print(wj)## X3 X7 X8
## 0.3757909 0.3241028 0.3001063