EJERCICIO 1
library(dplyr)
library(psych)
load(("C:/Users/Usuario/Downloads/6-2.RData"))
bartlett.test_result <- cortest.bartlett(X6_2)
print(bartlett.test_result)
## $chisq
## [1] 163.4656
##
## $p.value
## [1] 2.362835e-15
##
## $df
## [1] 45
KMO_result <- KMO(X6_2)
print(KMO_result)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = X6_2)
## Overall MSA = 0.7
## MSA for each item =
## V1 V2 V3 V4 V5 V6 V7 V8 V9 V10
## 0.82 0.74 0.84 0.93 0.55 0.32 0.37 0.62 0.68 0.84
analisis_factorial <- fa(X6_2, nfactors = 2, rotate = "varimax", fm = "ml")
print(analisis_factorial)
## Factor Analysis using method = ml
## Call: fa(r = X6_2, nfactors = 2, rotate = "varimax", fm = "ml")
## Standardized loadings (pattern matrix) based upon correlation matrix
## ML1 ML2 h2 u2 com
## V1 0.85 -0.18 0.75 0.25 1.1
## V2 0.92 -0.02 0.85 0.15 1.0
## V3 0.80 -0.19 0.68 0.32 1.1
## V4 0.91 -0.20 0.87 0.13 1.1
## V5 -0.44 0.75 0.76 0.24 1.6
## V6 -0.09 0.90 0.83 0.17 1.0
## V7 0.30 0.46 0.30 0.70 1.7
## V8 -0.85 -0.03 0.72 0.28 1.0
## V9 -0.87 -0.06 0.76 0.24 1.0
## V10 -0.79 -0.34 0.74 0.26 1.4
##
## ML1 ML2
## SS loadings 5.42 1.83
## Proportion Var 0.54 0.18
## Cumulative Var 0.54 0.72
## Proportion Explained 0.75 0.25
## Cumulative Proportion 0.75 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 factors are sufficient.
##
## df null model = 45 with the objective function = 11.02 with Chi Square = 163.47
## df of the model are 26 and the objective function was 2.5
##
## The root mean square of the residuals (RMSR) is 0.05
## The df corrected root mean square of the residuals is 0.07
##
## The harmonic n.obs is 20 with the empirical chi square 5.3 with prob < 1
## The total n.obs was 20 with Likelihood Chi Square = 33.78 with prob < 0.14
##
## Tucker Lewis Index of factoring reliability = 0.87
## RMSEA index = 0.111 and the 90 % confidence intervals are 0 0.234
## BIC = -44.11
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## ML1 ML2
## Correlation of (regression) scores with factors 0.98 0.94
## Multiple R square of scores with factors 0.96 0.89
## Minimum correlation of possible factor scores 0.92 0.78
EJERCICIO 2
library(dplyr)
library(psych)
library(kableExtra)
library(tidyr)
cargas <- as.data.frame(analisis_factorial$loadings[])
cargas$variable <- rownames(cargas)
cargas <- cargas %>%
gather(key = "Factor", value = "Carga", -variable) %>%
group_by(Factor) %>%
mutate(Peso_Normalizado = abs(Carga) / sum(abs(Carga))) %>%
ungroup()
cargas_comparativa <- cargas %>%
group_by(variable) %>%
summarize(
Peso_Normalizado = sum(Peso_Normalizado),
Peso_Suma_Rangos = 1 / row_number(),
Peso_Puntos = if_else(row_number() == 1, 0.5, 0.5 / row_number()))
cuadro_comparativo <- cargas_comparativa %>%
select(variable, Peso_Normalizado, Peso_Suma_Rangos, Peso_Puntos)
cuadro_comparativo %>%
kbl(caption = "Comparación de Técnicas de Ponderación Subjetiva") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Comparación de Técnicas de Ponderación Subjetiva
|
variable
|
Peso_Normalizado
|
Peso_Suma_Rangos
|
Peso_Puntos
|
|
V1
|
0.1805277
|
1.0
|
0.50
|
|
V1
|
0.1805277
|
0.5
|
0.25
|
|
V10
|
0.2249201
|
1.0
|
0.50
|
|
V10
|
0.2249201
|
0.5
|
0.25
|
|
V2
|
0.1408411
|
1.0
|
0.50
|
|
V2
|
0.1408411
|
0.5
|
0.25
|
|
V3
|
0.1789592
|
1.0
|
0.50
|
|
V3
|
0.1789592
|
0.5
|
0.25
|
|
V4
|
0.1980492
|
1.0
|
0.50
|
|
V4
|
0.1980492
|
0.5
|
0.25
|
|
V5
|
0.3046849
|
1.0
|
0.50
|
|
V5
|
0.3046849
|
0.5
|
0.25
|
|
V6
|
0.3013019
|
1.0
|
0.50
|
|
V6
|
0.3013019
|
0.5
|
0.25
|
|
V7
|
0.1896425
|
1.0
|
0.50
|
|
V7
|
0.1896425
|
0.5
|
0.25
|
|
V8
|
0.1352643
|
1.0
|
0.50
|
|
V8
|
0.1352643
|
0.5
|
0.25
|
|
V9
|
0.1458093
|
1.0
|
0.50
|
|
V9
|
0.1458093
|
0.5
|
0.25
|
EJERCICIO 3
library(dplyr)
library(tidyr)
library(kableExtra)
datos_normalizados <- as.data.frame(scale(X6_2))
desviacion <- apply(datos_normalizados, 2, sd)
correlacion <- cor(datos_normalizados)
critic_weights <- sapply(1:ncol(datos_normalizados), function(i) {
desv_i <- desviacion[i]
correlacion_media <- mean(abs(correlacion[i, -i]))
desv_i * (1 - correlacion_media)
})
critic_weights <- critic_weights / sum(critic_weights)
probabilidades <- datos_normalizados / rowSums(datos_normalizados)
k <- -1 / log(nrow(datos_normalizados))
entropia <- -k * rowSums(probabilidades * log(probabilidades + 1e-10))
entropia_weights <- (1 - entropia) / sum(1 - entropia)
cuadro_ponderaciones <- data.frame(
Variable = colnames(X6_2),
Peso_CRITIC = critic_weights,
Peso_Entropia = entropia_weights
)
cuadro_ponderaciones %>%
kbl(caption = "Comparación de Técnicas de Ponderación Objetiva: CRITIC y Entropía") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Comparación de Técnicas de Ponderación Objetiva: CRITIC y Entropía
|
Variable
|
Peso_CRITIC
|
Peso_Entropia
|
|
V1
|
0.0829849
|
NaN
|
|
V2
|
0.0783144
|
NaN
|
|
V3
|
0.0879014
|
NaN
|
|
V4
|
0.0739659
|
NaN
|
|
V5
|
0.1174628
|
NaN
|
|
V6
|
0.1459887
|
NaN
|
|
V7
|
0.1463237
|
NaN
|
|
V8
|
0.0861189
|
NaN
|
|
V9
|
0.0862378
|
NaN
|
|
V10
|
0.0947014
|
NaN
|
|
V1
|
0.0829849
|
NaN
|
|
V2
|
0.0783144
|
NaN
|
|
V3
|
0.0879014
|
NaN
|
|
V4
|
0.0739659
|
NaN
|
|
V5
|
0.1174628
|
NaN
|
|
V6
|
0.1459887
|
NaN
|
|
V7
|
0.1463237
|
NaN
|
|
V8
|
0.0861189
|
NaN
|
|
V9
|
0.0862378
|
NaN
|
|
V10
|
0.0947014
|
NaN
|