TG

Simulación 2 factores, 8 ítems, 4 opciones de respuesta

library(LikertMakeR)

## Warning: package 'LikertMakeR' was built under R version 4.2.3

items281 <- 8
alpha281 <- 0.99
variance281 <- 0.3
set.seed(281)
cor_matrix281 <- makeCorrAlpha(items = items281, alpha = alpha281, variance = variance281)

## correlation values consistent with desired alpha in 476 iterations
## The correlation matrix is positive definite

print(cor_matrix281)

##           [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]
## [1,] 1.0000000 0.8766379 0.8863575 0.8918675 0.9121207 0.9125133 0.9130426
## [2,] 0.8766379 1.0000000 0.9149542 0.9150986 0.9172325 0.9194192 0.9209743
## [3,] 0.8863575 0.9149542 1.0000000 0.9229692 0.9230875 0.9262572 0.9274586
## [4,] 0.8918675 0.9150986 0.9229692 1.0000000 0.9315816 0.9352133 0.9361518
## [5,] 0.9121207 0.9172325 0.9230875 0.9315816 1.0000000 0.9431279 0.9442587
## [6,] 0.9125133 0.9194192 0.9262572 0.9352133 0.9431279 1.0000000 0.9548960
## [7,] 0.9130426 0.9209743 0.9274586 0.9361518 0.9442587 0.9548960 1.0000000
## [8,] 0.9136340 0.9216606 0.9297038 0.9405496 0.9491377 0.9599598 0.9664193
##           [,8]
## [1,] 0.9136340
## [2,] 0.9216606
## [3,] 0.9297038
## [4,] 0.9405496
## [5,] 0.9491377
## [6,] 0.9599598
## [7,] 0.9664193
## [8,] 1.0000000

CREACION DE LOS MODELOS

library(lavaan)

## This is lavaan 0.6-18
## lavaan is FREE software! Please report any bugs.

twof_cor0_load03_05 <- '
  F1 =~ 0.31*x1 + 0.35*x2 + 0.4*x3+0.45*x4
  F2 =~ 0.5*x5+0.45*x6+0.40*x7+0.35*x8
F1 ~~ 0*F2'

twof_cor0_load05_07 <- '
  F1 =~ 0.51*x1 + 0.55*x2 + 0.6*x3+0.65*x4
  F2 =~ 0.7*x5+0.65*x6+0.6*x7+0.55*x8
F1 ~~ 0*F2'


twof_cor03_load03_05 <- '
  F1 =~ 0.31*x1 + 0.35*x2 + 0.4*x3+0.45*x4
  F2 =~ 0.5*x5+0.45*x6+0.40*x7+0.35*x8
F1~~0.3*F2'

twof_cor03_load05_07 <- '
  F1 =~ 0.51*x1 + 0.55*x2 + 0.6*x3+0.65*x4
  F2 =~ 0.7*x5+0.65*x6+0.6*x7+0.55*x8
F1~~0.3*F2'

twof_cor05_load03_05 <- '
  F1 =~ 0.31*x1 + 0.35*x2 + 0.4*x3+0.45*x4
  F2 =~ 0.5*x5+0.45*x6+0.40*x7+0.35*x8
F1~~0.5*F2'

twof_cor05_load05_07 <- '
  F1 =~ 0.51*x1 + 0.55*x2 + 0.6*x3+0.65*x4
  F2 =~ 0.7*x5+0.65*x6+0.6*x7+0.55*x8
F1~~0.5*F2'
mod2f<- c(twof_cor0_load03_05, twof_cor0_load05_07, twof_cor03_load03_05, twof_cor03_load05_07,
          twof_cor05_load03_05, twof_cor05_load05_07)

Creacion objetos

library(doParallel)

## Warning: package 'doParallel' was built under R version 4.2.3

## Loading required package: foreach

## Warning: package 'foreach' was built under R version 4.2.3

## Loading required package: iterators

## Warning: package 'iterators' was built under R version 4.2.3

## Loading required package: parallel

library(foreach)
seeds2100<-list(NULL) # semillas aleatorios
data2100 <- list(NULL) # primeras bases de datos con base a los modelos lavaan
iter<-100 # itereaciones 
registerDoParallel(cores = 2) # cores para el desarrollo
cor_matrices2100 <- list(NULL) # objeto para guardar las primeras matrices de correlacion
n2100 <- 100 # Tamaño de muestra
lower2100 <- 1 # limite inferior - opciones de respuesta
upper2100 <- 4 # limite superior - opciones de respuesta
dfMeans2100 <- rep(2.5, 8) # media opciones de respuesta
dfSds2100 <- rep(1, 8) # desviacion estadar opciones de respuesta
basef2100 <- list(NULL) # base final simulada valores entre 1 y 4
cor_pearson2100 <- list(NULL) # matrices de pearson
cor_spearman2100 <- list(NULL) # matrices de spearman

Creacion funcion para limpiar matrices

clean_matrix <- function(mat) {
  if (is.matrix(mat)) {
    # Eliminar nombres de filas y columnas
    rownames(mat) <- NULL
    colnames(mat) <- NULL
    # Asegurarse de que todos los elementos sean numéricos
    as.matrix(mat)
  } else {
    stop("El objeto no es una matriz.")
  }
}

Creación bases de datos

for (i in 1:iter) {
  # Guardar la semilla
  seeds2100[[i]] <- .Random.seed
  
  # Generar datos acorde a cada modelo lavaan
  data2100[[i]] <- foreach(b = 1:6, .combine = list, .multicombine = TRUE) %dopar% {
    lavaan::simulateData(model = mod2f[[b]], sample.nobs = n2100, model.type = "cfa", 
                         ov.var = cor_matrix281, return.type = "data.frame", 
                         return.fit = FALSE, standardized = FALSE)
  }
  
  # Limpiar y redondear las matrices de correlación
  cor_matrices2100[[i]] <- lapply(data2100[[i]], function(df) {
    cor_matrix <- cor(as.matrix(df))
    clean_matrix(cor_matrix)
  })
  
  # Creando base de datos estilo Likert
  basef2100[[i]] <- foreach(c = 1:6, .combine = list, .multicombine = TRUE) %dopar% {
    LikertMakeR::makeItems(
      n = n2100, means = dfMeans2100, sds = dfSds2100,
      lowerbound = rep(lower2100, 8), upperbound = rep(upper2100, 8),
      cormatrix = cor_matrices2100[[i]][[c]]
    )
  }
  
  # Creando las nuevas matrices de correlación
  cor_pearson2100[[i]] <- foreach(dataset = basef2100[[i]], .combine = 'list', .multicombine = TRUE) %dopar% {
    cor_matrixp <- cor(as.matrix(dataset)) 
    clean_matrix(cor_matrixp)
  }
  
  cor_spearman2100[[i]] <- foreach(dataset = basef2100[[i]], .combine = 'list', .multicombine = TRUE) %dopar% {
    cor_matrixsp <- cor(as.matrix(dataset), method = "spearman") 
    clean_matrix(cor_matrixsp)
  }
}

Análisis paralelo (AP)

Matriz de correlación de Pearson

library(psych)

## 
## Attaching package: 'psych'

## The following object is masked from 'package:lavaan':
## 
##     cor2cov

## The following object is masked from 'package:LikertMakeR':
## 
##     alpha

library(doRNG)

## Warning: package 'doRNG' was built under R version 4.2.3

## Loading required package: rngtools

## Warning: package 'rngtools' was built under R version 4.2.3

fa_parallel_pearson1 <- foreach(j = 1:6, .combine = 'list', .packages = c("psych", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "psych", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    res <- fa.parallel(cor_pearson2100[[i]][[j]], fa = "fa", fm = "pa", n.obs = n2100)
    res$nfact  
  }
fa_parallel_pearson1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 3 5 4 0 3 0 4 2 2 2 2 2 2 1 2 3 4 4 1 3 2 2 2 2 2 2 2 3 6 1 2 3 0 0 4 2 5
##  [38] 3 2 2 2 2 2 3 3 3 3 1 2 3 2 2 0 2 4 3 2 1 3 3 3 3 2 1 3 3 4 3 1 2 0 2 0 2
##  [75] 2 4 3 2 0 4 3 2 2 3 0 2 3 2 3 2 2 0 1 2 2 2 3 3 2 2
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 3 2 2 2 3 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 3 2 3 3 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 5 2 3 2 2 3 3 2 2 2 2 2 2 2 2 2 2 2
##  [75] 3 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 3 3 2
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 3 3 1 2 0 4 0 4 3 4 2 1 2 5 2 2 4 2 2 4 3 3 0 2 3 3 2 2 5 3 3 3 0 4 3 2 2
##  [38] 1 3 0 3 3 2 3 2 2 3 1 2 0 1 3 2 0 0 1 0 2 0 0 1 1 0 0 4 3 2 3 1 2 1 5 0 4
##  [75] 2 2 3 1 2 2 1 2 2 3 3 1 4 2 2 2 4 0 2 0 3 4 2 4 3 4
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 3 2 2 2 3 2 2 2 2 3 4 2 2 3 2 3 2 2 3 3 2 2
##  [38] 2 3 3 3 2 4 2 3 2 2 2 2 2 2 2 2 2 3 3 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 3
##  [75] 2 3 2 3 3 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 2 3 2 2 4 2
## 
## 
## [[1]][[2]]
##   [1] 4 1 3 1 2 0 2 1 3 2 4 2 3 2 2 4 1 4 2 1 1 3 2 3 4 2 2 4 3 3 3 2 4 3 2 1 3
##  [38] 3 1 3 1 5 3 4 5 2 2 0 1 3 1 2 1 3 3 4 1 0 3 3 2 5 2 4 1 4 2 3 2 1 5 2 2 2
##  [75] 2 2 0 1 5 2 2 1 2 3 1 1 2 2 3 2 2 3 5 2 1 4 3 1 3 3
## 
## 
## [[2]]
##   [1] 2 2 2 2 3 3 1 2 2 3 2 3 2 3 2 3 2 3 4 2 2 2 2 2 2 2 3 2 2 2 4 3 2 2 2 2 3
##  [38] 2 2 2 2 3 2 2 5 2 3 2 3 2 2 1 2 3 2 3 2 2 3 2 3 3 2 3 3 3 2 2 2 3 3 3 2 4
##  [75] 2 2 2 2 2 2 3 2 2 2 1 2 2 2 2 2 2 1 2 2 2 2 1 2 3 2

Matriz de correlación de Spearman

fa_parallel_spearman1 <- foreach(j = 1:6, .combine = 'list', .packages = c("psych", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "psych", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    res <- fa.parallel(cor_spearman2100[[i]][[j]], fa = "fa", fm = "pa", n.obs = n2100)
    res$nfact  
  }
fa_parallel_spearman1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 3 4 4 0 3 0 3 2 2 2 2 2 2 1 2 4 4 4 3 3 2 2 2 2 2 2 2 3 6 1 2 4 0 0 4 2 5
##  [38] 3 2 2 2 2 0 0 3 3 3 1 2 3 3 2 0 2 4 3 2 1 3 3 3 2 2 1 3 3 4 3 1 2 0 2 0 2
##  [75] 2 4 4 0 0 4 3 4 2 4 0 2 3 2 3 2 2 0 1 2 2 2 3 3 2 2
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 3 2 2 2 3 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 3 2 3 3 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 3 2 2 3 3 2 2 2 2 2 2 2 2 2 2 2
##  [75] 3 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 3 3 2
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 3 3 1 2 0 4 0 4 3 4 2 1 2 4 2 2 3 2 5 4 3 3 0 2 3 3 2 2 5 3 3 3 0 4 3 2 6
##  [38] 1 3 0 3 3 2 3 2 2 4 1 2 0 1 3 2 0 0 1 0 2 0 0 1 1 0 0 2 3 1 3 1 2 5 4 0 2
##  [75] 2 0 3 1 2 3 1 2 2 3 3 1 4 5 2 2 4 0 2 0 3 0 2 0 4 4
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 3 2 2 2 3 2 2 2 2 3 4 2 2 3 2 3 2 2 3 3 2 2
##  [38] 2 3 3 3 2 4 2 4 2 2 2 2 2 2 2 3 2 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3
##  [75] 2 3 2 3 3 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 2 3 2 2 4 2
## 
## 
## [[1]][[2]]
##   [1] 4 1 3 1 3 0 0 5 3 2 3 1 3 2 2 4 1 0 2 1 1 0 2 3 4 2 2 4 3 3 3 2 4 1 2 1 3
##  [38] 3 1 3 1 5 3 1 5 2 2 0 1 3 1 2 1 3 3 4 1 0 3 3 2 5 2 0 1 4 2 3 2 1 5 2 2 2
##  [75] 2 2 0 1 5 2 2 1 2 3 1 1 2 2 3 2 2 3 5 2 1 4 3 1 3 3
## 
## 
## [[2]]
##   [1] 2 2 2 2 3 3 1 2 2 3 2 3 2 3 2 3 2 2 4 2 2 2 2 2 2 2 3 2 2 2 4 3 2 2 2 2 3
##  [38] 2 2 2 2 3 2 2 5 2 3 2 3 2 2 1 2 3 3 3 2 2 3 2 3 3 2 3 2 3 2 2 2 3 3 3 2 4
##  [75] 2 2 2 2 2 2 3 2 2 2 1 2 2 2 2 2 2 1 2 2 2 2 1 2 3 3

Mínimo promedio parcial (MAP)

Correlación de Pearson

library(EFA.dimensions)

## **************************************************************************************************
## EFA.dimensions 0.1.8.4
## 
## Please contact Brian O'Connor at brian.oconnor@ubc.ca if you have questions or suggestions.
## **************************************************************************************************

MAP_pearson1 <- foreach(j = 1:6, .combine = 'list', .packages = c("EFA.dimensions", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "EFA.dimensions", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    res <- MAP(cor_pearson2100[[i]][[j]], Ncases = n2100)
    res$NfactorsMAP  
  }
MAP_pearson1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0
##  [38] 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 2 0 0 0 0 0 0 0 0 0 2 0 0 0 0 1 0
##  [75] 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## 
## [[1]][[1]][[2]]
##   [1] 0 0 0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1
##  [38] 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 2 1 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 1 1
##  [75] 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 2 0 1 1 0 0 1 0 0
## 
## 
## [[1]][[2]]
##   [1] 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## 
## [[2]]
##   [1] 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0
##  [38] 0 0 1 1 0 0 1 1 1 1 0 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1
##  [75] 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1

Correlación de Spearman

MAP_spearman1 <- foreach(j = 1:6, .combine = 'list', .packages = c("EFA.dimensions", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "EFA.dimensions", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    res <- MAP(cor_spearman2100[[i]][[j]], Ncases = n2100)
    res$NfactorsMAP  
  }
MAP_spearman1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0
##  [38] 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 0 1 0
##  [75] 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## 
## [[1]][[1]][[2]]
##   [1] 0 0 0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1
##  [38] 0 1 0 0 0 0 1 0 1 0 0 0 0 1 0 0 2 1 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 1 1
##  [75] 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 1 0 2 0 0 1 0 0 1 0 0
## 
## 
## [[1]][[2]]
##   [1] 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## 
## [[2]]
##   [1] 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0
##  [38] 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1 1 0 1 1
##  [75] 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1

Análisis exploratorio gráfico (AEG)

Correlación de pearson

library(EGAnet)

## Warning: package 'EGAnet' was built under R version 4.2.3

## [1;m[4;m
## EGAnet (version 2.0.6)[0m[0m 
## 
## For help getting started, see <https://r-ega.net> 
## 
## For bugs and errors, submit an issue to <https://github.com/hfgolino/EGAnet/issues>

EGA_pearson1 <- foreach(j = 1:6, .combine = 'list', .packages = c("EGAnet", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "EGAnet", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    res <- tryCatch(EGA(cor_pearson2100[[i]][[j]], n = n2100, plot.EGA = FALSE),
    warn=FALSE, error=function(e) return(NA))
    res$n.dim 
  }
EGA_pearson1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 0 1 0 0 0 1 1 2 0 1 1 0 0 1 0 1 0 0 0 0 0 2 2 0 0 1 0 0 1 0 0 0 0 0 2 2 0
##  [38] 0 0 0 0 2 0 1 0 0 2 0 0 0 0 1 0 0 1 1 2 1 2 0 0 2 0 1 0 1 0 0 0 1 0 2 0 0
##  [75] 0 0 0 0 0 0 0 0 0 2 0 3 0 2 2 1 0 0 0 1 2 0 2 0 2 0
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 1 2 2 3 2 1 2 0 2 0 2 0 2 2 2 0 2 2 2 2 2 2 2 2 2 0 0 2 1 0
##  [38] 2 2 2 2 0 2 2 2 2 2 2 2 2 2 2 1 2 0 2 0 2 2 2 2 0 2 2 2 0 2 2 1 0 0 2 2 2
##  [75] 3 2 2 2 3 2 2 2 2 2 2 2 2 1 3 2 2 2 2 2 2 2 1 2 2 0
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 0 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 0 2 0 0 0 2 1 2 1 0 0 0 0 0 0 0 0 2 1 0 1
##  [38] 0 0 0 2 2 1 2 0 0 0 1 0 0 0 1 2 0 0 0 3 2 1 0 1 0 0 1 0 0 1 2 0 1 0 1 1 0
##  [75] 0 1 1 0 2 0 1 0 2 1 0 0 1 1 2 0 0 0 0 1 0 0 0 0 1 0
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 0 2 2 3 2 2 3 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 1 2 2 2 2 2 2 2 2 0 2
##  [38] 0 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 0 2 2 2 2 2 0 2 2 2 2 2
##  [75] 2 2 3 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2
## 
## 
## [[1]][[2]]
##   [1] 0 2 0 0 0 2 0 0 3 1 0 1 1 1 0 0 0 1 0 0 2 0 1 1 0 0 1 2 1 1 0 0 0 0 2 1 0
##  [38] 0 0 0 1 0 0 0 0 1 1 0 0 2 0 0 0 2 1 0 0 0 1 1 2 0 2 0 0 0 1 0 0 0 0 1 0 0
##  [75] 0 0 1 0 3 0 0 0 1 0 0 0 2 0 0 0 1 0 0 0 1 0 1 0 2 2
## 
## 
## [[2]]
##   [1] 1 2 2 3 2 2 0 2 2 0 2 2 2 3 3 2 2 1 3 2 0 2 0 2 2 2 2 2 1 2 2 3 2 2 2 2 3
##  [38] 2 2 2 2 2 2 0 2 2 0 2 2 2 2 1 2 3 2 2 2 2 1 2 2 2 0 3 2 3 3 2 1 0 2 3 2 1
##  [75] 2 2 2 2 2 2 2 2 1 2 1 2 2 0 2 2 2 1 2 2 0 2 2 1 0 2

Correlacion de Spearman

EGA_spearman1 <- foreach(j = 1:6, .combine = 'list', .packages = c("EGAnet", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "EGAnet", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    res <- tryCatch(EGA(cor_spearman2100[[i]][[j]], n = n2100, plot.EGA = FALSE),
    warn=FALSE, error=function(e) return(NA))
    res$n.dim 
  }
EGA_spearman1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 0 0 0 0 0 0 1 2 0 1 1 0 0 0 0 1 2 0 1 0 0 2 2 0 0 1 1 0 1 0 0 0 1 0 2 2 0
##  [38] 0 0 0 0 2 1 0 0 0 2 0 0 0 0 1 0 0 1 1 1 0 0 0 0 2 0 1 0 1 0 0 0 0 0 2 0 0
##  [75] 2 0 0 0 0 0 0 0 0 3 0 3 0 0 0 1 0 0 0 1 2 1 2 0 2 0
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 1 2 2 3 2 1 2 2 2 0 2 0 2 2 2 0 2 2 2 2 2 2 2 2 2 0 0 0 1 0
##  [38] 2 2 2 2 1 2 2 2 2 2 2 2 2 0 2 2 2 0 2 0 2 2 2 2 3 2 2 2 0 2 2 1 0 1 2 2 2
##  [75] 2 2 2 2 3 2 2 2 2 2 2 2 2 0 3 2 2 2 2 2 2 2 1 2 2 0
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 0 1 0 1 0 2 1 0 0 0 1 0 1 0 1 0 0 2 0 0 0 2 1 1 1 0 0 0 0 1 0 0 0 2 0 2 0
##  [38] 0 0 0 2 1 1 2 0 0 0 1 0 0 0 1 2 0 2 2 0 2 0 0 0 0 0 0 0 0 1 2 0 1 0 0 0 0
##  [75] 0 0 0 0 0 1 0 0 2 1 1 0 1 1 2 0 0 1 0 0 0 0 0 0 0 0
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 1 1 2 3 2 2 3 2 0 2 2 2 2 2 2 0 2 2 2 2 2 2 2 2 2 0 2 2 2 2 2 2 2 0 1 2
##  [38] 0 2 2 2 2 4 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 2 2 0 2 2 2 2 2
##  [75] 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 0 2
## 
## 
## [[1]][[2]]
##   [1] 0 0 0 0 0 2 0 0 3 1 1 1 1 1 0 0 0 1 0 0 2 0 1 1 0 0 1 0 1 1 0 0 0 0 2 1 0
##  [38] 0 0 0 0 0 0 0 0 1 0 0 0 2 0 0 0 2 1 0 0 0 1 0 2 0 0 0 0 0 1 0 0 0 0 0 0 0
##  [75] 1 0 1 0 3 0 0 0 1 3 0 0 2 0 0 0 1 0 0 0 1 0 1 0 2 2
## 
## 
## [[2]]
##   [1] 1 2 2 3 2 2 0 2 2 0 2 2 2 3 3 2 2 1 3 2 0 2 1 2 3 1 2 2 1 2 2 3 2 0 2 2 3
##  [38] 2 2 2 2 2 2 0 2 2 2 2 2 2 2 1 2 3 2 2 2 2 1 2 2 3 1 3 2 2 3 2 1 0 0 3 2 0
##  [75] 2 2 2 2 2 2 2 2 1 2 1 2 2 0 2 2 2 1 2 2 1 2 2 2 0 2

Componentes principales categórico (Kaiser - Princals)

Correlación de Pearson (sin ajustar por variables continuas)

library(Gifi)

## Warning: package 'Gifi' was built under R version 4.2.3

PRINCAL_pearson1 <- foreach(j = 1:6, .combine = 'list', .packages = c("Gifi", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "Gifi", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    invisible(capture.output({
  res <- princals(cor_pearson2100[[i]][[j]])
  }))
  sum(res$evals >= 1, na.rm = T)  
  }
PRINCAL_pearson1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 1 2 2 2 2 2 2 2 1 1 2 2 2 2 1 1 2 1 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 1 2 2 2 2 2 2 1 1 2 2 2 2 2 2 1 2 2 2 2 1 1 2 2 2 1 2 2 2 1 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 1 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 2 2
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 3 2 1 2 2 2 2 2 2 2 2 2 2 2
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## 
## [[1]][[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## 
## [[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 3 2 2

Correlación de Pearson (ajustando por variables continuas)

PRINCAL_pearson1b <- foreach(j = 1:6, .combine = 'list', .packages = c("Gifi", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "Gifi", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    invisible(capture.output({
  res <- princals(cor_pearson2100[[i]][[j]], levels = "metric")
  }))
  sum(res$evals >= 1, na.rm = T)  
  }
PRINCAL_pearson1b

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 4 4 3 4 3 3 4 4 3 3 4 3 3 4 4 3 4 4 3 4 3 3 3 3 3 3 3 3 4 2 3 3 4 3 3 4 3
##  [38] 3 3 3 4 3 3 3 3 4 3 4 4 4 3 3 3 3 4 3 4 4 3 3 3 3 3 3 2 3 3 3 3 4 4 3 3 4
##  [75] 3 3 3 3 4 3 3 3 3 3 3 2 3 3 4 3 3 3 3 3 4 4 4 3 3 3
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 3 2 3 2 3 2 3 3 3 2 3 1 3 3 2 2 3 2 2 2 3 1 4 2 2 2 2 2 1 2 2 2 3 2 3 2 2
##  [38] 2 2 3 2 2 2 4 2 2 1 3 3 2 2 3 3 2 1 3 3 1 2 2 2 3 2 2 2 3 2 2 3 2 3 2 3 2
##  [75] 3 2 3 2 2 2 2 2 2 3 2 1 2 2 3 3 2 2 2 2 3 3 3 2 2 3
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 3 3 4 3 4 3 4 3 3 3 3 4 4 4 4 4 3 4 4 3 3 3 3 4 3 3 3 3 4 4 3 3 4 3 4 3 4
##  [38] 4 3 4 3 2 4 3 3 3 3 4 4 3 4 3 3 3 4 5 3 4 3 4 4 4 5 4 4 3 4 3 4 4 4 3 4 4
##  [75] 4 3 4 4 3 4 4 3 3 3 3 3 4 3 2 3 4 4 3 4 4 4 3 4 3 4
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 3 4 3 4 3 3 3 3 4 3 3 3 3 2 3 4 2 4 4 3 3 3 2 3 4 3 3 2 2 2 2 1 3 3 3 4
##  [38] 3 2 3 3 1 3 3 3 2 3 2 3 3 3 1 3 2 3 4 4 2 2 3 2 4 3 3 2 3 3 3 3 3 3 3 3 4
##  [75] 3 3 2 4 3 2 2 3 4 2 3 3 2 3 2 3 3 2 2 2 3 3 2 3 2 2
## 
## 
## [[1]][[2]]
##   [1] 4 4 4 4 3 4 4 4 3 3 3 4 3 4 4 4 4 3 4 5 4 3 4 3 3 4 4 3 4 4 3 4 4 4 4 4 4
##  [38] 3 4 3 4 4 4 3 4 4 3 3 4 3 4 4 4 3 4 4 4 4 4 3 3 4 4 3 3 4 4 3 4 4 4 4 4 4
##  [75] 4 3 3 4 4 4 4 4 4 3 5 4 4 4 3 4 4 3 3 4 4 4 2 4 4 4
## 
## 
## [[2]]
##   [1] 3 3 2 2 3 3 5 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 4 4 3 2 3 3 4 2 3 4 3 3 4 4 2
##  [38] 4 3 3 2 4 3 4 4 4 3 2 3 4 2 4 3 3 3 3 4 3 3 4 3 3 3 3 4 3 4 3 3 3 3 3 3 3
##  [75] 4 3 4 3 3 3 2 3 3 3 4 3 3 4 4 3 3 4 3 3 4 3 4 4 4 4

Correlación de Spearman (sin ajustar por variables continuas)

PRINCAL_spearman1 <- foreach(j = 1:6, .combine = 'list', .packages = c("Gifi", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "Gifi", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    invisible(capture.output({
  res <- princals(cor_spearman2100[[i]][[j]])
}))
    sum(res$evals >= 1, na.rm = T)
  }
PRINCAL_spearman1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 1
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 2 2 2 1 2 2 2 1 2 2 2 2 1 2 1 2 2 2 2 2 2
##  [38] 2 1 2 2 2 2 2 2 1 2 2 1 2 2 2 2 1 2 2 2 2 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 1 1 2 2 2 2 2 2 2 2 2 1 2 2
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2
##  [38] 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## 
## [[1]][[2]]
##   [1] 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## 
## [[2]]
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 1 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2

Correlación de Spearman (ajustando por variables continuas)

PRINCAL_spearman1b <- foreach(j = 1:6, .combine = 'list', .packages = c("Gifi", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "Gifi", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    invisible(capture.output({
  res <- princals(cor_spearman2100[[i]][[j]], levels = "metric")
}))
    sum(res$evals >= 1, na.rm = T)
  }
PRINCAL_spearman1b

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 4 4 4 4 3 3 4 4 3 4 4 3 3 4 4 3 4 4 3 4 3 3 3 3 3 3 3 3 4 2 3 3 4 3 3 4 3
##  [38] 3 3 3 4 3 3 3 4 4 3 4 4 4 3 3 3 3 4 3 3 4 3 4 3 3 3 3 2 3 3 3 4 4 4 3 3 4
##  [75] 3 3 3 4 4 3 3 3 3 3 3 2 3 3 4 3 3 3 3 3 4 4 4 3 3 3
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 3 2 3 2 3 2 3 3 3 2 3 1 3 3 2 2 3 2 3 2 3 1 4 2 2 2 2 3 1 2 2 2 3 2 3 2 2
##  [38] 2 2 3 2 2 2 4 2 2 2 3 3 2 2 3 3 2 1 3 3 1 2 2 2 3 2 2 2 3 2 2 3 2 3 2 3 2
##  [75] 3 2 3 2 2 2 2 2 2 3 2 1 2 2 3 3 2 2 3 2 3 3 3 2 2 3
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 3 3 4 3 4 3 4 3 3 3 3 4 4 4 4 4 3 3 4 3 3 3 3 4 3 3 4 3 4 4 3 3 4 3 3 4 4
##  [38] 4 3 4 4 3 4 3 3 3 3 4 4 3 4 3 3 3 4 5 3 4 3 4 4 4 5 4 4 3 4 3 4 4 4 3 4 4
##  [75] 4 3 4 4 3 4 4 4 3 3 3 4 4 3 3 3 4 4 3 4 4 4 3 3 3 4
## 
## 
## [[1]][[1]][[2]]
##   [1] 2 3 4 3 4 3 3 3 3 4 3 3 3 3 2 3 4 2 3 4 3 3 3 2 3 4 3 3 2 2 2 2 1 3 3 3 4
##  [38] 3 2 3 3 2 3 3 3 2 3 2 3 3 3 1 3 2 3 3 4 2 2 2 2 4 3 3 2 3 3 3 3 3 3 3 3 3
##  [75] 3 3 2 4 3 3 2 3 4 2 3 3 2 3 2 3 3 3 2 2 3 3 2 3 2 2
## 
## 
## [[1]][[2]]
##   [1] 4 4 4 4 3 4 4 4 3 3 3 4 3 4 4 4 4 3 4 5 4 3 4 3 3 4 4 3 4 4 3 4 4 4 4 4 4
##  [38] 3 3 3 4 4 4 4 4 4 3 4 4 3 4 4 4 3 4 4 4 4 4 3 3 4 4 3 3 4 4 3 4 4 4 4 4 4
##  [75] 4 3 3 4 4 4 4 4 4 3 5 4 4 4 3 4 4 3 3 4 4 4 3 4 4 4
## 
## 
## [[2]]
##   [1] 3 3 2 2 3 3 5 3 2 3 3 3 3 3 3 3 3 3 3 3 3 3 4 3 3 2 3 3 4 2 3 4 4 3 4 4 2
##  [38] 4 3 3 3 4 3 4 4 4 3 2 3 4 2 4 3 3 3 3 4 3 3 4 3 4 3 4 4 3 4 3 3 3 3 3 3 4
##  [75] 4 3 4 3 3 3 2 3 3 3 4 3 3 4 3 3 3 4 3 3 4 3 4 4 4 4

PRINCALS base de datos

PRINCALS_base1 <- foreach(j = 1:6, .combine = 'list', .packages = c("Gifi", "foreach", "doRNG")) %:%
  foreach(i = 1:iter, .combine = 'c', .packages = "Gifi", .options.RNG = 1234) %dopar% {
    set.seed(1234 + i + j)
    invisible(capture.output({
  res <- princals(basef2100[[i]][[j]])
}))
    sum(res$evals >= 1, na.rm = T)
  }
PRINCALS_base1

## [[1]]
## [[1]][[1]]
## [[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]]
## [[1]][[1]][[1]][[1]][[1]]
##   [1] 3 3 3 3 3 3 3 3 3 3 2 3 3 3 2 3 3 3 3 4 3 3 3 3 3 3 3 3 3 2 3 3 3 3 3 2 3
##  [38] 3 4 3 3 3 3 2 3 3 3 3 3 3 2 3 4 3 4 3 3 3 3 4 3 3 3 3 3 2 3 3 2 3 3 2 4 3
##  [75] 3 4 3 3 2 2 3 3 3 3 3 2 3 3 3 2 3 4 3 3 3 3 3 3 3 3
## 
## [[1]][[1]][[1]][[1]][[2]]
##   [1] 3 2 3 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 3 2 2 2 2 3 2 3 2 2 2 2 2
##  [38] 2 2 2 2 3 2 2 2 2 2 3 3 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 3 3 2 2 2 3 3 3 2 3
##  [75] 2 3 2 3 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 2 2 3 3
## 
## 
## [[1]][[1]][[1]][[2]]
##   [1] 3 3 3 2 3 3 3 4 3 3 2 3 3 3 3 3 3 3 2 3 3 3 3 3 2 3 3 3 3 2 3 4 3 4 3 2 3
##  [38] 3 2 3 3 3 2 3 2 3 3 4 3 3 2 3 3 3 3 2 4 2 3 3 3 3 3 4 3 3 3 3 2 3 3 3 3 3
##  [75] 3 3 4 2 2 3 3 2 2 3 3 3 3 3 3 2 3 3 3 3 3 3 2 3 3 4
## 
## 
## [[1]][[1]][[2]]
##   [1] 3 2 2 2 2 2 2 3 2 2 3 3 2 3 2 3 2 2 2 3 2 2 2 2 3 3 2 2 3 2 3 2 2 2 3 3 3
##  [38] 2 2 2 3 2 2 3 3 2 2 2 3 2 2 2 2 2 3 2 2 2 2 3 3 2 3 2 2 2 2 3 2 2 2 2 2 3
##  [75] 2 2 2 2 3 2 2 2 2 2 2 2 2 3 2 2 3 2 2 2 2 2 2 2 2 2
## 
## 
## [[1]][[2]]
##   [1] 3 2 3 3 3 3 3 3 3 2 3 3 3 2 3 3 2 3 2 3 2 3 3 3 3 3 3 3 2 3 3 3 3 3 3 2 3
##  [38] 3 2 3 2 3 3 3 3 4 2 3 3 3 3 3 2 3 3 4 2 3 3 3 2 3 3 3 3 3 2 3 2 3 3 3 4 2
##  [75] 3 3 4 3 3 3 3 3 4 4 2 3 2 3 3 3 2 2 3 3 3 3 3 3 3 3
## 
## 
## [[2]]
##   [1] 3 2 2 2 2 2 2 3 2 3 2 2 2 3 2 3 2 3 3 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 3 3 3
##  [38] 3 2 2 2 3 3 2 2 2 2 2 2 2 2 3 2 2 2 2 3 3 3 2 3 2 2 2 2 3 3 2 2 3 3 3 2 3
##  [75] 2 2 2 3 2 3 3 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 3 2 3 2

Medidas de precisión - exactitud

procesar_lista <- function(lista) {
  vector <- unlist(lista)
  split(vector, ceiling(seq_along(vector) / iter))
}

listas <- list(fa_parallel_spearman1, fa_parallel_pearson1, MAP_spearman1, MAP_pearson1, 
               EGA_pearson1, EGA_spearman1, PRINCAL_pearson1, PRINCAL_spearman1, PRINCAL_pearson1b, PRINCAL_spearman1b, PRINCALS_base1)

bloques <- lapply(listas, procesar_lista)

names(bloques) <- c("fa_parallel_spearman1", "fa_parallel_pearson1", "MAP_spearman1", 
                    "MAP_pearson1", "EGA_pearson1", "EGA_spearman1", 
                    "PRINCAL_pearson1", "PRINCAL_spearman1",  "PRINCAL_pearson1b", "PRINCAL_spearman1b","PRINCALS_base1")

proporcion_correcta <- function(results, correct_value = 2) {
  correct_counts <- sum(results == correct_value)
  correct_counts / length(results)
}
mbe <- function(results, correct_value = 2) {
  sum(correct_value - results) / length(results)
}
mae <- function(results, correct_value = 2) {
  mean(abs(correct_value - results))
}

resultados <- lapply(bloques, function(bloque) {
  lapply(bloque, function(data) {
    list(
      PC = proporcion_correcta(data),
      MBE = mbe(data),
      MAE = mae(data)
    )
  })
})

data_frames <- lapply(resultados, function(res) {
  do.call(rbind, lapply(res, function(r) {
    data.frame(PC = r$PC, MBE = r$MBE, MAE = r$MAE)
  }))
})

names(data_frames) <- c("fa_parallel_spearman1", "fa_parallel_pearson1", "MAP_spearman1", "MAP_pearson1", "EGA_pearson1", "EGA_spearman1", 
 "PRINCAL_pearson1", "PRINCAL_spearman1",  "PRINCAL_pearson1b", "PRINCAL_spearman1b","PRINCALS_base1")

newnames<- c("CB_ort", "CA_ort", "CB_obl_03", "CA_obl_03", "CB_obli_05", "CA_obli_05")

data_frames <- lapply(data_frames, function(df) {
  rownames(df) <- newnames
  return(df)
})
data_frames

## $fa_parallel_spearman1
##              PC   MBE  MAE
## CB_ort     0.40 -0.26 0.92
## CA_ort     0.85 -0.15 0.15
## CB_obl_03  0.27 -0.13 1.15
## CA_obl_03  0.75 -0.29 0.29
## CB_obli_05 0.29 -0.23 1.01
## CA_obli_05 0.65 -0.30 0.40
## 
## $fa_parallel_pearson1
##              PC   MBE  MAE
## CB_ort     0.43 -0.27 0.83
## CA_ort     0.84 -0.18 0.18
## CB_obl_03  0.31 -0.14 1.04
## CA_obl_03  0.75 -0.28 0.28
## CB_obli_05 0.32 -0.38 0.96
## CA_obli_05 0.65 -0.30 0.40
## 
## $MAP_spearman1
##              PC  MBE  MAE
## CB_ort     0.00 2.00 2.00
## CA_ort     0.01 1.87 1.87
## CB_obl_03  0.00 1.99 1.99
## CA_obl_03  0.02 1.51 1.51
## CB_obli_05 0.00 1.93 1.93
## CA_obli_05 0.00 1.23 1.23
## 
## $MAP_pearson1
##              PC  MBE  MAE
## CB_ort     0.00 1.99 1.99
## CA_ort     0.02 1.83 1.83
## CB_obl_03  0.00 2.00 2.00
## CA_obl_03  0.02 1.48 1.48
## CB_obli_05 0.00 1.92 1.92
## CA_obli_05 0.01 1.18 1.18
## 
## $EGA_pearson1
##              PC  MBE  MAE
## CB_ort     0.17 1.44 1.46
## CA_ort     0.74 0.33 0.41
## CB_obl_03  0.13 1.43 1.45
## CA_obl_03  0.85 0.10 0.22
## CB_obli_05 0.12 1.46 1.50
## CA_obli_05 0.67 0.22 0.44
## 
## $EGA_spearman1
##              PC  MBE  MAE
## CB_ort     0.14 1.47 1.51
## CA_ort     0.75 0.31 0.39
## CB_obl_03  0.14 1.50 1.50
## CA_obl_03  0.84 0.13 0.25
## CB_obli_05 0.09 1.51 1.57
## CA_obli_05 0.65 0.21 0.45
## 
## $PRINCAL_pearson1
##              PC   MBE  MAE
## CB_ort     0.98 -0.02 0.02
## CA_ort     0.82  0.18 0.18
## CB_obl_03  0.97  0.01 0.03
## CA_obl_03  0.97  0.03 0.03
## CB_obli_05 0.99 -0.01 0.01
## CA_obli_05 0.97 -0.01 0.03
## 
## $PRINCAL_spearman1
##              PC   MBE  MAE
## CB_ort     0.97  0.01 0.03
## CA_ort     0.85  0.15 0.15
## CB_obl_03  0.96  0.00 0.04
## CA_obl_03  0.98  0.02 0.02
## CB_obli_05 0.99 -0.01 0.01
## CA_obli_05 0.98  0.02 0.02
## 
## $PRINCAL_pearson1b
##              PC   MBE  MAE
## CB_ort     0.03 -1.27 1.27
## CA_ort     0.57 -0.31 0.45
## CB_obl_03  0.02 -1.50 1.50
## CA_obl_03  0.28 -0.80 0.86
## CB_obli_05 0.01 -1.71 1.71
## CA_obli_05 0.11 -1.19 1.19
## 
## $PRINCAL_spearman1b
##              PC   MBE  MAE
## CB_ort     0.03 -1.32 1.32
## CA_ort     0.55 -0.35 0.47
## CB_obl_03  0.00 -1.54 1.54
## CA_obl_03  0.28 -0.79 0.83
## CB_obli_05 0.00 -1.73 1.73
## CA_obli_05 0.09 -1.23 1.23
## 
## $PRINCALS_base1
##              PC   MBE  MAE
## CB_ort     0.13 -0.95 0.95
## CA_ort     0.77 -0.23 0.23
## CB_obl_03  0.19 -0.89 0.89
## CA_obl_03  0.73 -0.27 0.27
## CB_obli_05 0.21 -0.85 0.85
## CA_obli_05 0.68 -0.32 0.32

Graficos

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.2.3

## 
## Attaching package: 'ggplot2'

## The following objects are masked from 'package:psych':
## 
##     %+%, alpha

## The following object is masked from 'package:LikertMakeR':
## 
##     alpha

data_long <- do.call(rbind, lapply(names(data_frames), function(name) {
  df <- data_frames[[name]]
  df$modelo <- name
  df$condicion <- rownames(df)
  df
}))
ggplot(data_long, aes(x = condicion, y = PC, fill = modelo)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Proporciones Correctas por Modelo y Condición",
       x = "Condición",
       y = "Proporción Correcta") +
  theme_minimal()

ggplot(data_long, aes(x = condicion, y = MBE, color = modelo)) +
  geom_point(position = position_dodge(width = 0.5)) +
  geom_errorbar(aes(ymin = MBE - MAE, ymax = MBE + MAE),
                width = 0.2, position = position_dodge(width = 0.5)) +
  labs(title = "Desviación de MBE con MAE como Error",
       x = "Condición",
       y = "MBE (MAE como barras de error)") +
  theme_minimal()

data_long <- do.call(rbind, lapply(names(data_frames), function(name) {
  df <- data_frames[[name]]
  df$model <- name
  df$condition <- rownames(df)
  df <- reshape2::melt(df, id.vars = c("model", "condition"))
  df
}))

ggplot(data_long, aes(x = condition, y = value, group = variable, color = variable)) +
  geom_line() +
  geom_point() +
  facet_wrap(~ model, scales = "free_y") +
  labs(title = "Gráfico Línea para PC, MBE, y MAE",
       x = "Condición",
       y = "Valor") +
  theme_minimal()

TG

NMR

2024-08-20