datos<-read_table2("http://halweb.uc3m.es/esp/Personal/personas/agrane/libro/ficheros_datos/capitulo_7/datos_prob_7_3.txt", col_names = FALSE)
head(datos)## # A tibble: 6 x 8
## X1 X2 X3 X4 X5 X6 X7 X8
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 30 41 670 3903 12 94 341 1.2
## 2 124 46 410 955 6 57 89 0.5
## 3 95 48 370 6 5 26 20 0.1
## 4 90 43 680 435 8 20 331 1.6
## 5 112 41 100 1293 2 51 22 0.1
## 6 73 51 390 6115 4 35 93 0.2Solución rotada
modelo_4<-principal(r = datos, 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
Normalización de 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 %>% dplyr::select(X3, X7, X8) %>% dplyr::transmute(X3=norm_directa(X3), X7=norm_directa(X7), X8=norm_inverza(X8))-> factor_1
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 0Creación de función método CRITIC
ponderadores_critic_2<-function(factor){
vector_sd<- apply(X = factor, MARGIN = 2, FUN = sd)
matriz_R<-cor(factor)
sum_data<-1-matriz_R
sum_vector<-colSums(sum_data)
ponderadores_brutos<-vector_sd*sum_vector
ponderadores_netos<-round((ponderadores_brutos/sum(ponderadores_brutos))*100,2)
list("Vector de desviaciones"=vector_sd,
"Matriz de correlación"=matriz_R,
"1 - matriz de correlación"=sum_data,
"Promedio"=sum_vector,
"Ponderadores brutos"=ponderadores_brutos,
"Ponderadores netos"=ponderadores_netos)
}prueba<- ponderadores_critic_2(factor = factor_1)
prueba$`Ponderadores netos`## X3 X7 X8
## 25.90 27.95 46.15Selección de variables
variables<-datos %>% dplyr::select(X3, X7, X8)
variables## # A tibble: 18 x 3
## X3 X7 X8
## <dbl> <dbl> <dbl>
## 1 670 341 1.2
## 2 410 89 0.5
## 3 370 20 0.1
## 4 680 331 1.6
## 5 100 22 0.1
## 6 390 93 0.2
## 7 250 29 0.1
## 8 600 204 0.6
## 9 280 110 0.2
## 10 80 40 0.1
## 11 200 28 0.1
## 12 380 300 0.6
## 13 600 97 0.4
## 14 260 66 0.1
## 15 120 34 0.1
## 16 260 206 0.7
## 17 400 149 0.3
## 18 540 438 1.8Creación de función método Entropía
ponderadores_entropia<-function(dato){
datos_norm<-apply(X = dato, MARGIN = 2, FUN = prop.table)
entropia<-function(x){
return(x*log(x))
}
datos_norm_2<-apply(X = datos_norm,MARGIN = 2, FUN = entropia)
m<-nrow(datos_norm)
k<- -1/log(m)
ej<- k*colSums(datos_norm_2)
vj<- 1-ej
wj<-round((prop.table(vj))*100,2)
return(list("Datos normalizados"=datos_norm,
"Datos corregidos"=datos_norm_2,
"Constante de entropía"= k,
"Entropías"=ej,
"Especificidades"=vj,
"Ponderadores"=wj))
}ponderadores_entropia(dato = variables)## $`Datos normalizados`
## 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
##
## $`Datos corregidos`
## 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
##
## $`Constante de entropía`
## [1] -0.3459763
##
## $Entropías
## X3 X7 X8
## 0.9528297 0.8740529 0.8374802
##
## $Especificidades
## X3 X7 X8
## 0.04717033 0.12594714 0.16251976
##
## $Ponderadores
## X3 X7 X8
## 14.05 37.52 48.42