EGA paso a paso
Dr. José Ventura-León
2025-02-01
1 Carga de Librerías
Para la ejecución de este análisis es necesario contar con varias librerías que permiten trabajar con redes empíricas, análisis psicométricos y manipulación de datos. Se suprimen los mensajes de carga para evitar saturar la consola con mensajes innecesarios.
suppressPackageStartupMessages({
library(readxl)
library(EGAnet)
library(InterconectaR)
library(PsyMetricTools)
library(dplyr)
library(tidyverse)
library(psych)
})## Warning: package 'EGAnet' was built under R version 4.4.2## Warning: package 'lubridate' was built under R version 4.4.22 Carga y Limpieza de Datos
En este análisis utilizaremos el conjunto de datos
psych::bfi, que contiene información sobre rasgos de
personalidad del Big Five Inventory. Primero, los datos se convierten en
un formato tibble para facilitar su manipulación. Luego, se eliminan las
filas con valores faltantes (na.omit()) y se excluyen
variables que no son relevantes para el análisis, como género, educación
y edad. Finalmente, se renombran las columnas para una mejor
interpretación.
data_bfi <- psych::bfi %>%
as_tibble() %>%
na.omit() %>%
select(-gender, -education, -age)
# Renombramos las columnas para facilitar la interpretación
data_bfi <- data_bfi %>% rename_with(~ paste0("bif", 1:25), everything())3 Análisis Descriptivo
Para visualizar la distribución de las respuestas en los ítems, se utiliza un gráfico de Likert. Esta representación gráfica permite evaluar de manera rápida cómo se distribuyen las respuestas en los distintos ítems del cuestionario.
PsyMetricTools::Plot_Likert(data_bfi, "bif", 1:25)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## ℹ The deprecated feature was likely used in the PsyMetricTools package.
## Please report the issue to the authors.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
4 Análisis de Redundancia
Para mejorar la estructura del modelo, se evalúa la redundancia entre los ítems. Esto permite identificar y eliminar aquellos ítems que aportan información redundante, optimizando la calidad del análisis de redes.
Redundancia <- EGAnet::UVA(data_bfi)
Redundancia$keep_remove## $keep
## [1] "bif17"
##
## $remove
## [1] "bif16"data_bfi_reduced <- Redundancia$reduced_data5 Evaluación de Dimensionalidad
El análisis de grafos empíricos (EGA) permite estimar la estructura
dimensional subyacente en los datos. Se emplea el método
glasso con correlaciones de Spearman y el algoritmo de
Louvain para la detección de comunidades.
ega.bfi <- EGA(
data = data_bfi_reduced,
corr = "spearman",
model = "glasso",
algorithm = "louvain",
plot.EGA = TRUE
) 
6 Extracción de Información del Modelo
Una vez obtenido el modelo EGA, es útil extraer sus resultados en formato de tabla para su posterior análisis y reporte.
InterconectaR::convert_EGA_to_df(ega.bfi)## Model Correlation Algorithm Lambda Nodes Edges Density Mean_Weight SD_Weight
## 1 GLASSO spearman NA 0.055 24 128 0.444 0.035 0.107
## Min_Weight Max_Weight Communities TEFI
## 1 -0.246 0.365 5 -25.1247 Análisis EGA con Combinaciones
Para evaluar la estabilidad del modelo, se prueban diferentes combinaciones de correlaciones y algoritmos de detección de comunidades. Esto permite comparar su impacto en la estructura de red.
resultados_bfi <- run_EGA_combinations(
data = data_bfi_reduced,
corr = c("cor_auto", "pearson", "spearman"),
algorithm = c("leiden", "louvain", "walktrap"),
leiden_args = list(objective_function = "CPM", resolution_parameter = 0.11)
)
attr(resultados_bfi, "combinations")## corr algorithm
## 1 cor_auto leiden
## 2 pearson leiden
## 3 spearman leiden
## 4 cor_auto louvain
## 5 pearson louvain
## 6 spearman louvain
## 7 cor_auto walktrap
## 8 pearson walktrap
## 9 spearman walktrapconvert_EGA_list_to_df(resultados_bfi) %>% arrange(desc(TEFI))## Model_Combination Correlation Algorithm Model Lambda Nodes Edges Density
## 1 cor_auto.louvain cor_auto louvain GLASSO 0.060 24 131 0.455
## 2 cor_auto.walktrap cor_auto walktrap GLASSO 0.060 24 131 0.455
## 3 spearman.louvain spearman louvain GLASSO 0.055 24 128 0.444
## 4 spearman.walktrap spearman walktrap GLASSO 0.055 24 128 0.444
## 5 pearson.louvain pearson louvain GLASSO 0.055 24 129 0.448
## 6 pearson.walktrap pearson walktrap GLASSO 0.055 24 129 0.448
## 7 cor_auto.leiden cor_auto leiden GLASSO 0.060 24 131 0.455
## 8 pearson.leiden pearson leiden GLASSO 0.055 24 129 0.448
## 9 spearman.leiden spearman leiden GLASSO 0.055 24 128 0.444
## Mean_Weight SD_Weight Min_Weight Max_Weight Communities TEFI
## 1 0.037 0.112 -0.272 0.396 5 -25.306
## 2 0.037 0.112 -0.272 0.396 5 -25.306
## 3 0.035 0.107 -0.246 0.365 5 -25.124
## 4 0.035 0.107 -0.246 0.365 5 -25.124
## 5 0.036 0.103 -0.250 0.367 5 -24.953
## 6 0.036 0.103 -0.250 0.367 5 -24.953
## 7 0.037 0.112 -0.272 0.396 6 -20.498
## 8 0.036 0.103 -0.250 0.367 7 -17.507
## 9 0.035 0.107 -0.246 0.365 7 -17.4318 Selección del Mejor Modelo
Una vez evaluadas las distintas combinaciones, se selecciona la mejor opción y se ejecuta nuevamente el modelo EGA.
ega.bfi.new <- EGA(
data = data_bfi_reduced,
corr = "cor_auto",
model = "glasso",
algorithm = "louvain",
plot.EGA = TRUE
)
9 Análisis de Estabilidad del Ítem
Para evaluar la estabilidad de los ítems en la red, se realiza un análisis de bootstraping con 1000 iteraciones. Este procedimiento ayuda a identificar ítems poco consistentes.
boot.bfi <- bootEGA(
data = data_bfi_reduced %>% as.data.frame() %>% select(-bif13, -bif15),
corr = "cor_auto",
model = "glasso",
algorithm = "louvain",
iter = 1000,
seed = 2024,
type = "resampling",
ncores = 12
)
10 Evaluación de Consistencia Estructural
Se revisa la consistencia estructural de las dimensiones encontradas en el modelo EGA.
boot.bfi$stability$dimension.stability$structural.consistency## 1 2 3 4 5
## 1.000 1.000 0.812 1.000 1.00011 Invarianza de Red según Sexo
Para evaluar si la estructura del modelo varía según el género de los participantes, se realiza un análisis de invarianza de red.
data_bfi.invariance <- psych::bfi %>%
as_tibble() %>%
na.omit() %>%
select(-education, -age)
results <- invariance(data = data_bfi.invariance %>% select(-gender),
groups = data_bfi.invariance$gender,
ncores = 10)## Testing configural invariance...##
## Configural invariance was found with 25 variables## Testing metric invariance...## The default 'loading.method' has changed to "revised" in {EGAnet} version >= 2.0.7.
##
## For the previous default (version <= 2.0.6), use `loading.method = "original"`
## The default 'loading.method' has changed to "revised" in {EGAnet} version >= 2.0.7.
##
## For the previous default (version <= 2.0.6), use `loading.method = "original"`plot(results, p_type = "p_BH", p_value = 0.01)
12 Información de la Sesión
Finalmente, se imprime información sobre el entorno de ejecución.
sessionInfo()## R version 4.4.1 (2024-06-14 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 22000)
##
## Matrix products: default
##
##
## locale:
## [1] LC_COLLATE=Spanish_Peru.utf8 LC_CTYPE=Spanish_Peru.utf8
## [3] LC_MONETARY=Spanish_Peru.utf8 LC_NUMERIC=C
## [5] LC_TIME=Spanish_Peru.utf8
##
## time zone: America/Lima
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] psych_2.4.6.26 lubridate_1.9.4 forcats_1.0.0
## [4] stringr_1.5.1 purrr_1.0.2 readr_2.1.5
## [7] tidyr_1.3.1 tibble_3.2.1 ggplot2_3.5.1
## [10] tidyverse_2.0.0 dplyr_1.1.4 PsyMetricTools_1.0.0
## [13] InterconectaR_1.0.0 EGAnet_2.1.0 readxl_1.4.3
## [16] bookdown_0.41
##
## loaded via a namespace (and not attached):
## [1] mnormt_2.1.1 pbapply_1.7-2 gridExtra_2.3
## [4] fdrtool_1.2.18 rlang_1.1.4 magrittr_2.0.3
## [7] compiler_4.4.1 png_0.1-8 vctrs_0.6.5
## [10] reshape2_1.4.4 quadprog_1.5-8 pkgconfig_2.0.3
## [13] crayon_1.5.3 fastmap_1.2.0 backports_1.5.0
## [16] labeling_0.4.3 pbivnorm_0.6.0 utf8_1.2.4
## [19] rmarkdown_2.29 tzdb_0.4.0 network_1.19.0
## [22] xfun_0.49 cachem_1.1.0 jsonlite_1.8.9
## [25] progress_1.2.3 jpeg_0.1-10 broom_1.0.7
## [28] prettyunits_1.2.0 parallel_4.4.1 lavaan_0.6-19
## [31] cluster_2.1.8 R6_2.5.1 bslib_0.8.0
## [34] stringi_1.8.4 RColorBrewer_1.1-3 GGally_2.2.1
## [37] car_3.1-3 parallelly_1.40.1 rpart_4.1.23
## [40] jquerylib_0.1.4 cellranger_1.1.0 Rcpp_1.0.12
## [43] knitr_1.49 future.apply_1.11.3 base64enc_0.1-3
## [46] Matrix_1.7-1 nnet_7.3-19 igraph_2.1.2
## [49] timechange_0.3.0 tidyselect_1.2.1 rstudioapi_0.17.1
## [52] abind_1.4-8 yaml_2.3.8 codetools_0.2-20
## [55] qgraph_1.9.8 listenv_0.9.1 lattice_0.22-6
## [58] plyr_1.8.9 withr_3.0.2 coda_0.19-4.1
## [61] evaluate_1.0.1 foreign_0.8-87 future_1.34.0
## [64] ggstats_0.7.0 ggpubr_0.6.0 pillar_1.9.0
## [67] carData_3.0-5 checkmate_2.3.2 stats4_4.4.1
## [70] generics_0.1.3 hms_1.1.3 munsell_0.5.1
## [73] scales_1.3.0 gtools_3.9.5 globals_0.16.3
## [76] glue_1.8.0 Hmisc_5.2-1 tools_4.4.1
## [79] data.table_1.16.4 ggsignif_0.6.4 cowplot_1.1.3
## [82] grid_4.4.1 colorspace_2.1-1 nlme_3.1-166
## [85] htmlTable_2.4.3 Formula_1.2-5 cli_3.6.2
## [88] fansi_1.0.6 corpcor_1.6.10 glasso_1.11
## [91] gtable_0.3.6 rstatix_0.7.2 sass_0.4.9
## [94] digest_0.6.35 progressr_0.15.1 htmlwidgets_1.6.4
## [97] sna_2.8 farver_2.1.2 htmltools_0.5.8.1
## [100] lifecycle_1.0.4 statnet.common_4.10.0