library(lavaan)
## This is lavaan 0.6-19
## lavaan is FREE software! Please report any bugs.
library(psych)
## 
## Attaching package: 'psych'
## The following object is masked from 'package:lavaan':
## 
##     cor2cov
data("HolzingerSwineford1939")
dat<- HolzingerSwineford1939
afa <- dat[, c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9")]

Korelasyon matrisi

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ readr     2.1.5
## ✔ ggplot2   3.5.1     ✔ stringr   1.5.1
## ✔ lubridate 1.9.4     ✔ tibble    3.2.1
## ✔ purrr     1.0.4     ✔ tidyr     1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ ggplot2::%+%()   masks psych::%+%()
## ✖ ggplot2::alpha() masks psych::alpha()
## ✖ dplyr::filter()  masks stats::filter()
## ✖ dplyr::lag()     masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
library(knitr)


matris <- round(cor(afa),2)
matris[upper.tri(matris)] <- NA
matris
##      x1    x2   x3   x4   x5   x6   x7   x8 x9
## x1 1.00    NA   NA   NA   NA   NA   NA   NA NA
## x2 0.30  1.00   NA   NA   NA   NA   NA   NA NA
## x3 0.44  0.34 1.00   NA   NA   NA   NA   NA NA
## x4 0.37  0.15 0.16 1.00   NA   NA   NA   NA NA
## x5 0.29  0.14 0.08 0.73 1.00   NA   NA   NA NA
## x6 0.36  0.19 0.20 0.70 0.72 1.00   NA   NA NA
## x7 0.07 -0.08 0.07 0.17 0.10 0.12 1.00   NA NA
## x8 0.22  0.09 0.19 0.11 0.14 0.15 0.49 1.00 NA
## x9 0.39  0.21 0.33 0.21 0.23 0.21 0.34 0.45  1

KMO

library(psych)

KMO(afa)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = afa)
## Overall MSA =  0.75
## MSA for each item = 
##   x1   x2   x3   x4   x5   x6   x7   x8   x9 
## 0.81 0.78 0.73 0.76 0.74 0.81 0.59 0.68 0.79

# 0,75 yeterli bir değer.

Bartlett testi

cortest.bartlett(afa)
## R was not square, finding R from data
## $chisq
## [1] 904.0971
## 
## $p.value
## [1] 1.912079e-166
## 
## $df
## [1] 36

Çıkarılacak Faktörlerin Sayısı

 fa(afa)$e.values
## [1] 3.2163442 1.6387132 1.3651593 0.6989185 0.5843475 0.4996872 0.4731021
## [8] 0.2860024 0.2377257

#1 den büyük olanlar çıkarılacak faktörlerdir. #1. faktördeki yüklerin karelerinin toplamı 3,21

 sum(fa(afa)$e.values)
## [1] 9

#özdeğerlerin toplamı değişken sayısına eşit.

out <- fa(afa, nfactors = 3,fm="pa",rotate="none")
out
## Factor Analysis using method =  pa
## Call: fa(r = afa, nfactors = 3, rotate = "none", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
##     PA1   PA2   PA3   h2   u2 com
## x1 0.58  0.17  0.34 0.48 0.52 1.8
## x2 0.31  0.10  0.39 0.26 0.74 2.0
## x3 0.40  0.31  0.44 0.45 0.55 2.8
## x4 0.77 -0.36 -0.11 0.73 0.27 1.5
## x5 0.75 -0.40 -0.16 0.75 0.25 1.6
## x6 0.76 -0.33 -0.05 0.69 0.31 1.4
## x7 0.31  0.43 -0.48 0.51 0.49 2.7
## x8 0.39  0.54 -0.27 0.52 0.48 2.4
## x9 0.51  0.45  0.01 0.46 0.54 2.0
## 
##                        PA1  PA2  PA3
## SS loadings           2.83 1.21 0.81
## Proportion Var        0.31 0.13 0.09
## Cumulative Var        0.31 0.45 0.54
## Proportion Explained  0.58 0.25 0.17
## Cumulative Proportion 0.58 0.83 1.00
## 
## Mean item complexity =  2
## Test of the hypothesis that 3 factors are sufficient.
## 
## df null model =  36  with the objective function =  3.05 with Chi Square =  904.1
## df of  the model are 12  and the objective function was  0.08 
## 
## The root mean square of the residuals (RMSR) is  0.02 
## The df corrected root mean square of the residuals is  0.03 
## 
## The harmonic n.obs is  301 with the empirical chi square  7.87  with prob <  0.8 
## The total n.obs was  301  with Likelihood Chi Square =  22.54  with prob <  0.032 
## 
## Tucker Lewis Index of factoring reliability =  0.963
## RMSEA index =  0.054  and the 90 % confidence intervals are  0.016 0.088
## BIC =  -45.95
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    PA1  PA2  PA3
## Correlation of (regression) scores with factors   0.94 0.86 0.78
## Multiple R square of scores with factors          0.89 0.74 0.61
## Minimum correlation of possible factor scores     0.77 0.48 0.21

# x1 değişkenini 3 faktör %47 oranında açıklamıştır (Ortak varyans)

    scree(cor(afa), factors = FALSE)

#en büyük kırılma 4den itibaren başlamış. 3 faktörlü bir veri seti olduğu için grafik bu bilgiyi doğruluyor.

(residuals <-round(out$residual,2))
##       x1    x2    x3    x4    x5    x6    x7    x8    x9
## x1  0.52 -0.03  0.01  0.03 -0.01 -0.01 -0.02  0.00  0.02
## x2 -0.03  0.74  0.01 -0.01  0.01  0.01 -0.02  0.02  0.00
## x3  0.01  0.01  0.55  0.01 -0.03  0.02  0.03 -0.02 -0.02
## x4  0.03 -0.01  0.01  0.27  0.00  0.00  0.04 -0.03 -0.02
## x5 -0.01  0.01 -0.03  0.00  0.25  0.01 -0.03  0.02  0.03
## x6 -0.01  0.01  0.02  0.00  0.01  0.31  0.00  0.01 -0.02
## x7 -0.02 -0.02  0.03  0.04 -0.03  0.00  0.49  0.00 -0.01
## x8  0.00  0.02 -0.02 -0.03  0.02  0.01  0.00  0.48  0.01
## x9  0.02  0.00 -0.02 -0.02  0.03 -0.02 -0.01  0.01  0.54
sum(abs(residuals[lower.tri(residuals)])>0.05)
## [1] 0

# Artık korelasyonlar köşegenler dışında oldukça düşük, 3 faktör dışında farklı bir faktör oluşturmaya gerek yok. En büyük açıklanmayan varyans 2. değişkende

    fa.parallel(afa, fa = "fa")

## Parallel analysis suggests that the number of factors =  3  and the number of components =  NA

#3. faktörden itibaren üretilen verideki öz değerler gerçek verideki öz değer lerden küçüktür. 3faktör yeterli.

library(nFactors) 
## Zorunlu paket yükleniyor: lattice
## 
## Attaching package: 'nFactors'
## The following object is masked from 'package:lattice':
## 
##     parallel
PA<-nScree( x=out$e.values, aparallel=NULL,cor=TRUE, model="factors", criteria=NULL) 
PA$Components
##   noc naf nparallel nkaiser
## 1   3   1         3       3

#önerile faktör sayısı (3 n parallelll)

Örüntü Katsayıları

out <- fa(afa,3,fm="pa",rotate="none")
out$loadings[,1:3]
##          PA1         PA2          PA3
## x1 0.5756248  0.16920594  0.341965206
## x2 0.3085407  0.09697577  0.388532245
## x3 0.4002783  0.30983802  0.443639294
## x4 0.7685885 -0.35543214 -0.105973472
## x5 0.7502797 -0.40427234 -0.163531747
## x6 0.7631025 -0.32689710 -0.048903558
## x7 0.3066785  0.42907861 -0.483440222
## x8 0.3944831  0.54239175 -0.273280696
## x9 0.5050903  0.45350149  0.006389851

Her bir satırda bir değişkenin (örneğin, X1, X2) her bir faktörle olan yüklemeleri (korelasyonları) yer alır.

PA1, PA2, PA3 sütunları, her değişkenin her bir faktörle ne kadar ilişkili olduğunu gösterir.

Yükleme değerleri 0 ile 1 arasında olmalıdır. Yükleme değeri yüksek olan değişkenler, o faktörle güçlü bir şekilde ilişkilidir.

0.65, 0.80 gibi yüksek yüklemeler, o faktörün güçlü bir temsilcisi olduğunu gösterir.

Ortak varyans katsayıları

  out
## Factor Analysis using method =  pa
## Call: fa(r = afa, nfactors = 3, rotate = "none", fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
##     PA1   PA2   PA3   h2   u2 com
## x1 0.58  0.17  0.34 0.48 0.52 1.8
## x2 0.31  0.10  0.39 0.26 0.74 2.0
## x3 0.40  0.31  0.44 0.45 0.55 2.8
## x4 0.77 -0.36 -0.11 0.73 0.27 1.5
## x5 0.75 -0.40 -0.16 0.75 0.25 1.6
## x6 0.76 -0.33 -0.05 0.69 0.31 1.4
## x7 0.31  0.43 -0.48 0.51 0.49 2.7
## x8 0.39  0.54 -0.27 0.52 0.48 2.4
## x9 0.51  0.45  0.01 0.46 0.54 2.0
## 
##                        PA1  PA2  PA3
## SS loadings           2.83 1.21 0.81
## Proportion Var        0.31 0.13 0.09
## Cumulative Var        0.31 0.45 0.54
## Proportion Explained  0.58 0.25 0.17
## Cumulative Proportion 0.58 0.83 1.00
## 
## Mean item complexity =  2
## Test of the hypothesis that 3 factors are sufficient.
## 
## df null model =  36  with the objective function =  3.05 with Chi Square =  904.1
## df of  the model are 12  and the objective function was  0.08 
## 
## The root mean square of the residuals (RMSR) is  0.02 
## The df corrected root mean square of the residuals is  0.03 
## 
## The harmonic n.obs is  301 with the empirical chi square  7.87  with prob <  0.8 
## The total n.obs was  301  with Likelihood Chi Square =  22.54  with prob <  0.032 
## 
## Tucker Lewis Index of factoring reliability =  0.963
## RMSEA index =  0.054  and the 90 % confidence intervals are  0.016 0.088
## BIC =  -45.95
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    PA1  PA2  PA3
## Correlation of (regression) scores with factors   0.94 0.86 0.78
## Multiple R square of scores with factors          0.89 0.74 0.61
## Minimum correlation of possible factor scores     0.77 0.48 0.21

# h2 sütünu açıklanan varyans oranlarını gösterir. En yüksek x4 değişkeni.

Yüklerin Kareleri Toplamı-Açıklanan Varyans

sum(out$loadings[,1]^2)/9*100
## [1] 31.41691
sum(out$loadings[,2]^2)/9*100
## [1] 13.49584
sum(out$loadings[,3]^2)/9*100
## [1] 9.039061
out$Vaccounted
##                             PA1       PA2        PA3
## SS loadings           2.8275221 1.2146253 0.81351551
## Proportion Var        0.3141691 0.1349584 0.09039061
## Cumulative Var        0.3141691 0.4491275 0.53951810
## Proportion Explained  0.5823143 0.2501461 0.16753954
## Cumulative Proportion 0.5823143 0.8324605 1.00000000

# Her bir faktörün açıklanan varyans oranını gösterir. 1. faktör % 31, 2. faktör % 13, 3. faktör % 9 oranında açıklamaktadır. Toplam açıklanan varyans % 53 oranındadır.

Üretilen ve artık korelasyon matrisi

factor.model(out$loadings)
##            x1          x2         x3        x4        x5        x6          x7
## x1 0.47691481  0.32687705 0.43454580 0.3460381 0.3075522 0.3672245  0.08381469
## x2 0.32687705  0.25555894 0.32591709 0.1614984 0.1287498 0.1847464 -0.05159910
## x3 0.43454580  0.32591709 0.45303818 0.1505089 0.1025127 0.1824727  0.04122856
## x4 0.34603814  0.16149837 0.15050893 0.7282906 0.7376777 0.7078840  0.13443307
## x5 0.30755217  0.12874980 0.10251266 0.7376777 0.7530983 0.7126930  0.13568786
## x6 0.36722451  0.18474643 0.18247272 0.7078840 0.7126930 0.6915787  0.11740453
## x7 0.08381469 -0.05159910 0.04122856 0.1344331 0.1356879 0.1174045  0.51187462
## x8 0.22539772  0.06813458 0.20471859 0.1393722 0.1213888 0.1370892  0.48582309
## x9 0.36966276  0.20230220 0.34552349 0.2263404 0.1945759 0.2368748  0.34639902
##            x8        x9
## x1 0.22539772 0.3696628
## x2 0.06813458 0.2023022
## x3 0.20471859 0.3455235
## x4 0.13937224 0.2263404
## x5 0.12138877 0.1945759
## x6 0.13708918 0.2368748
## x7 0.48582309 0.3463990
## x8 0.52448810 0.4434788
## x9 0.44347885 0.4608206

#Üretilen korelasyon matrisinin köşegenindeki öğeler çıkarılan ortak varyanslardır.

rep_matrix <- factor.model(out$loadings)
diag(rep_matrix)==out$communality
##   x1   x2   x3   x4   x5   x6   x7   x8   x9 
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

Faktörlerin Yorumlanması

out$loadings
## 
## Loadings:
##    PA1    PA2    PA3   
## x1  0.576  0.169  0.342
## x2  0.309         0.389
## x3  0.400  0.310  0.444
## x4  0.769 -0.355 -0.106
## x5  0.750 -0.404 -0.164
## x6  0.763 -0.327       
## x7  0.307  0.429 -0.483
## x8  0.394  0.542 -0.273
## x9  0.505  0.454       
## 
##                  PA1   PA2   PA3
## SS loadings    2.828 1.215 0.814
## Proportion Var 0.314 0.135 0.090
## Cumulative Var 0.314 0.449 0.540

# bütün yükler 1. faktöre yüklenmiş gibi döndürelim biraz

out_dik <- fa(afa,3,fm="pa",rotate="varimax")
print(out_dik$loadings[,1:3], digits = 3, cut = 0.30)
##       PA1     PA3     PA2
## x1 0.2793  0.6129  0.1523
## x2 0.1022  0.4942 -0.0300
## x3 0.0382  0.6595  0.1291
## x4 0.8322  0.1607  0.0992
## x5 0.8587  0.0883  0.0892
## x6 0.7991  0.2137  0.0855
## x7 0.0931 -0.0808  0.7047
## x8 0.0510  0.1700  0.7021
## x9 0.1298  0.4143  0.5219

# dik döndürme sonucunda yükler güzel dağıldı. x1 x2 x3 2. faktörde, x4 x5 x6 1. faktörde, x7, x8, x9 3. faktörde toplandı.

out$Vaccounted[2:3,]
##                      PA1       PA2        PA3
## Proportion Var 0.3141691 0.1349584 0.09039061
## Cumulative Var 0.3141691 0.4491275 0.53951810
out$Vaccounted[2:3,]
##                      PA1       PA2        PA3
## Proportion Var 0.3141691 0.1349584 0.09039061
## Cumulative Var 0.3141691 0.4491275 0.53951810

# toplam açıklanan varyans değişmedi

Örüntü ve yapı katsayıları

out_dik$Phi
## NULL

#dik döndürmede faktörler arası korelasyon değeri yoktur. Örüntü katsayıları yapı katsayıları birbirine eşittir.

Faktör Puanı Kestirimi

out_dik <- fa(afa,3,rotate="varimax", scores="Anderson")
head(out_dik$scores)
##              MR1        MR3          MR2
## [1,]  0.09847506 -0.8280351 -0.003537455
## [2,] -1.34967717  0.6843043  0.942361500
## [3,] -1.87071276 -0.1817172 -1.234141568
## [4,] -0.07734837  1.0113368 -0.990323046
## [5,] -0.05927204 -0.6460524  0.408616056
## [6,] -1.69217423  0.4676333  1.352384857

EGAnet

library(EGAnet); library(psychTools)
## 
## EGAnet (version 2.3.0) 
## 
## For help getting started, see <https://r-ega.net> 
## 
## For bugs and errors, submit an issue to <https://github.com/hfgolino/EGAnet/issues>
## 
## Attaching package: 'psychTools'
## The following object is masked from 'package:dplyr':
## 
##     recode
# Perform Unique Variable Analysis
bfi_uva <- UVA(
  data = afa
)
# Print results
bfi_uva$keep_remove
## $keep
## [1] "x5" "x6" "x7"
## 
## $remove
## [1] "x4" "x4" "x6" "x8"
EGA(afa)

## Model: GLASSO (EBIC with gamma = 0.5)
## Correlations: auto
## Lambda: 0.103924976788167 (n = 100, ratio = 0.1)
## 
## Number of nodes: 9
## Number of edges: 18
## Edge density: 0.500
## 
## Non-zero edge weights: 
##      M    SD   Min   Max
##  0.168 0.130 0.018 0.405
## 
## ----
## 
## Algorithm:  Walktrap
## 
## Number of communities:  3
## 
## x1 x2 x3 x4 x5 x6 x7 x8 x9 
##  1  1  1  2  2  2  3  3  3 
## 
## ----
## 
## Unidimensional Method: Louvain
## Unidimensional: No
## 
## ----
## 
## TEFI: -5.15