PCA_Case_Commuter
Priyank Goyal
10/04/2020
Case
Commuters
Reading Data: this is an spss file
library(foreign)
raqData1 <- read.spss("COMMUTER data for Factor Analysis.sav",to.data.frame = TRUE)## re-encoding from UTF-8raqData2 <- raqData1[,-c(1,2,3,4)]We need to convert to numeric. First we need to determine the order
# Specify that they are ordinal variables with the given levels
raqData <- data.matrix(raqData2)
head(raqData)## q14_1 q14_2 q14_3 q14_4 q14_5 q14_6 q14_7 q14_8 q14_9 q14_10 q14_11
## [1,] 3 3 4 5 5 4 5 4 3 4 4
## [2,] 5 5 5 5 4 4 4 5 5 5 4
## [3,] 3 3 4 4 5 5 4 5 5 4 3
## [4,] 3 3 5 4 5 3 3 3 4 3 5
## [5,] 3 4 4 5 5 5 5 5 5 5 5
## [6,] 1 2 3 4 5 4 5 4 5 5 5
## q15_1 q15_2 q15_3 q15_4 q15_5
## [1,] 3 4 4 4 2
## [2,] 4 2 1 3 2
## [3,] 3 4 4 4 2
## [4,] 5 4 1 3 2
## [5,] 3 4 4 4 4
## [6,] 4 2 5 5 4Calculate the correlation matrix
raqmatrix <- round(cor(raqData),2)
raqmatrix## q14_1 q14_2 q14_3 q14_4 q14_5 q14_6 q14_7 q14_8 q14_9 q14_10 q14_11
## q14_1 1.00 0.40 0.21 0.30 0.21 0.29 0.37 0.22 0.22 0.13 0.08
## q14_2 0.40 1.00 0.37 0.23 0.11 0.22 0.29 0.25 0.12 0.13 0.17
## q14_3 0.21 0.37 1.00 0.30 0.03 0.19 0.30 0.20 0.12 0.17 0.21
## q14_4 0.30 0.23 0.30 1.00 0.10 0.03 0.37 0.47 0.14 0.12 0.30
## q14_5 0.21 0.11 0.03 0.10 1.00 0.36 -0.02 0.00 0.28 0.18 0.02
## q14_6 0.29 0.22 0.19 0.03 0.36 1.00 0.23 0.02 0.27 0.26 0.13
## q14_7 0.37 0.29 0.30 0.37 -0.02 0.23 1.00 0.44 0.17 0.16 0.25
## q14_8 0.22 0.25 0.20 0.47 0.00 0.02 0.44 1.00 0.17 0.14 0.35
## q14_9 0.22 0.12 0.12 0.14 0.28 0.27 0.17 0.17 1.00 0.31 0.18
## q14_10 0.13 0.13 0.17 0.12 0.18 0.26 0.16 0.14 0.31 1.00 0.36
## q14_11 0.08 0.17 0.21 0.30 0.02 0.13 0.25 0.35 0.18 0.36 1.00
## q15_1 0.42 0.23 0.10 0.11 0.14 0.21 0.23 0.10 0.19 0.13 0.06
## q15_2 0.21 0.24 0.17 0.16 0.06 0.14 0.21 0.18 0.10 0.13 0.18
## q15_3 0.15 0.18 0.17 0.14 0.07 0.14 0.17 0.15 0.11 0.14 0.18
## q15_4 0.16 0.14 0.13 0.10 0.12 0.19 0.16 0.12 0.21 0.18 0.19
## q15_5 0.12 0.12 0.17 0.11 0.05 0.13 0.18 0.15 0.14 0.19 0.24
## q15_1 q15_2 q15_3 q15_4 q15_5
## q14_1 0.42 0.21 0.15 0.16 0.12
## q14_2 0.23 0.24 0.18 0.14 0.12
## q14_3 0.10 0.17 0.17 0.13 0.17
## q14_4 0.11 0.16 0.14 0.10 0.11
## q14_5 0.14 0.06 0.07 0.12 0.05
## q14_6 0.21 0.14 0.14 0.19 0.13
## q14_7 0.23 0.21 0.17 0.16 0.18
## q14_8 0.10 0.18 0.15 0.12 0.15
## q14_9 0.19 0.10 0.11 0.21 0.14
## q14_10 0.13 0.13 0.14 0.18 0.19
## q14_11 0.06 0.18 0.18 0.19 0.24
## q15_1 1.00 0.47 0.36 0.44 0.33
## q15_2 0.47 1.00 0.55 0.37 0.36
## q15_3 0.36 0.55 1.00 0.38 0.38
## q15_4 0.44 0.37 0.38 1.00 0.48
## q15_5 0.33 0.36 0.38 0.48 1.00Run Barlette Test using psych package
library(psych)## Warning: package 'psych' was built under R version 3.6.1cortest.bartlett(raqData)## R was not square, finding R from data## $chisq
## [1] 22365.39
##
## $p.value
## [1] 0
##
## $df
## [1] 120The test data is highly significant and therefore factor analysis is appropriate
KMO Test
# KMO Kaiser-Meyer-Olkin Measure of Sampling Adequacy
# Function by G. Jay Kerns, Ph.D., Youngstown State University (http://tolstoy.newcastle.edu.au/R/e2/help/07/08/22816.html)
kmo = function( data ){
library(MASS)
X <- cor(as.matrix(data))
iX <- ginv(X)
S2 <- diag(diag((iX^-1)))
AIS <- S2%*%iX%*%S2 # anti-image covariance matrix
IS <- X+AIS-2*S2 # image covariance matrix
Dai <- sqrt(diag(diag(AIS)))
IR <- ginv(Dai)%*%IS%*%ginv(Dai) # image correlation matrix
AIR <- ginv(Dai)%*%AIS%*%ginv(Dai) # anti-image correlation matrix
a <- apply((AIR - diag(diag(AIR)))^2, 2, sum)
AA <- sum(a)
b <- apply((X - diag(nrow(X)))^2, 2, sum)
BB <- sum(b)
MSA <- b/(b+a) # indiv. measures of sampling adequacy
AIR <- AIR-diag(nrow(AIR))+diag(MSA)
# Examine the anti-image of the correlation matrix. That is the negative of the partial correlations, partialling out all other variables.
kmo <- BB/(AA+BB) # overall KMO statistic
# Reporting the conclusion
if (kmo >= 0.00 && kmo < 0.50){test <- 'The KMO test yields a degree of common variance unacceptable for FA.'}
else if (kmo >= 0.50 && kmo < 0.60){test <- 'The KMO test yields a degree of common variance miserable.'}
else if (kmo >= 0.60 && kmo < 0.70){test <- 'The KMO test yields a degree of common variance mediocre.'}
else if (kmo >= 0.70 && kmo < 0.80){test <- 'The KMO test yields a degree of common variance middling.' }
else if (kmo >= 0.80 && kmo < 0.90){test <- 'The KMO test yields a degree of common variance meritorious.' }
else { test <- 'The KMO test yields a degree of common variance marvelous.' }
ans <- list( overall = kmo,
report = test,
individual = MSA,
AIS = AIS,
AIR = AIR )
return(ans)
}
#To use this function:
kmo(raqData)## $overall
## [1] 0.8042321
##
## $report
## [1] "The KMO test yields a degree of common variance meritorious."
##
## $individual
## q14_1 q14_2 q14_3 q14_4 q14_5 q14_6 q14_7
## 0.7891549 0.8283102 0.8168148 0.7785251 0.6484295 0.7599644 0.8253166
## q14_8 q14_9 q14_10 q14_11 q15_1 q15_2 q15_3
## 0.7798936 0.8397510 0.8051963 0.7964800 0.8047499 0.8094086 0.8290392
## q15_4 q15_5
## 0.8358742 0.8474706
##
## $AIS
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.623805568 -0.171772025 0.0040912280 -0.1054796863 -0.065008627
## [2,] -0.171772025 0.718378062 -0.1915346887 0.0134681661 -0.020138152
## [3,] 0.004091228 -0.191534689 0.7671444798 -0.1319160135 0.049731029
## [4,] -0.105479686 0.013468166 -0.1319160135 0.6677066242 -0.092993104
## [5,] -0.065008627 -0.020138152 0.0497310294 -0.0929931044 0.779299725
## [6,] -0.078051303 -0.049933564 -0.0676132307 0.0938754650 -0.221124245
## [7,] -0.114708748 -0.018532712 -0.0811726142 -0.0868754767 0.125062532
## [8,] -0.005453541 -0.069269696 0.0301795121 -0.1917740435 0.015145417
## [9,] -0.049797101 0.030640547 -0.0156297886 -0.0001538801 -0.144213476
## [10,] 0.003677199 -0.003624925 -0.0395789182 0.0236269577 -0.054033432
## [11,] 0.053801237 -0.031478560 -0.0235704526 -0.1043327864 0.044721800
## [12,] -0.184523067 -0.011978302 0.0397325087 0.0214812950 -0.014532204
## [13,] 0.017455582 -0.059794768 -0.0052080152 -0.0157459574 0.012572970
## [14,] 0.014940174 -0.010710962 -0.0301669292 -0.0102403986 -0.008430249
## [15,] 0.032767175 0.004578999 0.0008769897 0.0023561658 -0.018411467
## [16,] 0.015342067 0.027925096 -0.0509042923 0.0184221270 0.009258011
## [,6] [,7] [,8] [,9] [,10]
## [1,] -0.0780513029 -0.114708748 -5.453541e-03 -0.0497971008 0.003677199
## [2,] -0.0499335636 -0.018532712 -6.926970e-02 0.0306405469 -0.003624925
## [3,] -0.0676132307 -0.081172614 3.017951e-02 -0.0156297886 -0.039578918
## [4,] 0.0938754650 -0.086875477 -1.917740e-01 -0.0001538801 0.023626958
## [5,] -0.2211242451 0.125062532 1.514542e-02 -0.1442134760 -0.054033432
## [6,] 0.7182357753 -0.117754780 7.579054e-02 -0.0715555933 -0.089029233
## [7,] -0.1177547796 0.648844558 -1.798551e-01 -0.0171774732 -0.009817681
## [8,] 0.0757905408 -0.179855128 6.464656e-01 -0.0651503386 0.001168531
## [9,] -0.0715555933 -0.017177473 -6.515034e-02 0.7954046121 -0.146899629
## [10,] -0.0890292329 -0.009817681 1.168531e-03 -0.1468996290 0.774395664
## [11,] -0.0410387013 -0.018987786 -1.275429e-01 -0.0237910824 -0.204500232
## [12,] -0.0115113175 -0.031301319 2.597675e-02 -0.0317245751 -0.004979098
## [13,] -0.0007262028 -0.012206974 -2.202121e-02 0.0285156161 0.006658847
## [14,] -0.0103089162 0.005035467 -9.729982e-03 0.0011092355 -0.008973261
## [15,] -0.0341467887 -0.001484600 -9.029549e-05 -0.0592836299 -0.016686692
## [16,] 0.0062053033 -0.023824114 -9.560992e-03 -0.0025250640 -0.034471914
## [,11] [,12] [,13] [,14] [,15]
## [1,] 0.05380124 -0.184523067 0.0174555824 0.014940174 3.276718e-02
## [2,] -0.03147856 -0.011978302 -0.0597947677 -0.010710962 4.578999e-03
## [3,] -0.02357045 0.039732509 -0.0052080152 -0.030166929 8.769897e-04
## [4,] -0.10433279 0.021481295 -0.0157459574 -0.010240399 2.356166e-03
## [5,] 0.04472180 -0.014532204 0.0125729697 -0.008430249 -1.841147e-02
## [6,] -0.04103870 -0.011511317 -0.0007262028 -0.010308916 -3.414679e-02
## [7,] -0.01898779 -0.031301319 -0.0122069736 0.005035467 -1.484600e-03
## [8,] -0.12754288 0.025976752 -0.0220212051 -0.009729982 -9.029549e-05
## [9,] -0.02379108 -0.031724575 0.0285156161 0.001109236 -5.928363e-02
## [10,] -0.20450023 -0.004979098 0.0066588466 -0.008973261 -1.668669e-02
## [11,] 0.71727321 0.059477788 -0.0322895880 -0.012180527 -3.353467e-02
## [12,] 0.05947779 0.585179225 -0.1645138244 -0.034411557 -1.497415e-01
## [13,] -0.03228959 -0.164513824 0.5806042323 -0.239418176 -3.309946e-02
## [14,] -0.01218053 -0.034411557 -0.2394181756 0.636218843 -7.670577e-02
## [15,] -0.03353467 -0.149741532 -0.0330994562 -0.076705772 6.432706e-01
## [16,] -0.07830159 -0.050271878 -0.0522990002 -0.096653370 -2.083593e-01
## [,16]
## [1,] 0.015342067
## [2,] 0.027925096
## [3,] -0.050904292
## [4,] 0.018422127
## [5,] 0.009258011
## [6,] 0.006205303
## [7,] -0.023824114
## [8,] -0.009560992
## [9,] -0.002525064
## [10,] -0.034471914
## [11,] -0.078301587
## [12,] -0.050271878
## [13,] -0.052299000
## [14,] -0.096653370
## [15,] -0.208359313
## [16,] 0.681188962
##
## $AIR
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.789154934 -0.256596827 0.005914125 -0.1634373694 -0.09323825
## [2,] -0.256596827 0.828310225 -0.258007498 0.0194463945 -0.02691478
## [3,] 0.005914125 -0.258007498 0.816814806 -0.1843172974 0.06431860
## [4,] -0.163437369 0.019446394 -0.184317297 0.7785251031 -0.12891565
## [5,] -0.093238249 -0.026914780 0.064318603 -0.1289156498 0.64842953
## [6,] -0.116606301 -0.069515638 -0.091087669 0.1355581840 -0.29556335
## [7,] -0.180302431 -0.027145142 -0.115053707 -0.1319878714 0.17587521
## [8,] -0.008587787 -0.101646875 0.042854942 -0.2918933931 0.02133812
## [9,] -0.070694460 0.040534604 -0.020008774 -0.0002111522 -0.18317219
## [10,] 0.005290675 -0.004860054 -0.051350406 0.0328574235 -0.06955508
## [11,] 0.080431345 -0.043852668 -0.031775108 -0.1507598365 0.05981701
## [12,] -0.305408832 -0.018474568 0.059301128 0.0343655396 -0.02151963
## [13,] 0.029004783 -0.092586263 -0.007803574 -0.0252892606 0.01869156
## [14,] 0.023715253 -0.015843411 -0.043180658 -0.0157116124 -0.01197250
## [15,] 0.051727028 0.006735924 0.001248415 0.0035951429 -0.02600395
## [16,] 0.023535609 0.039919432 -0.070417730 0.0273157500 0.01270667
## [,6] [,7] [,8] [,9] [,10]
## [1,] -0.116606301 -0.180302431 -0.0085877870 -0.0706944602 0.005290675
## [2,] -0.069515638 -0.027145142 -0.1016468747 0.0405346036 -0.004860054
## [3,] -0.091087669 -0.115053707 0.0428549423 -0.0200087736 -0.051350406
## [4,] 0.135558184 -0.131987871 -0.2918933931 -0.0002111522 0.032857423
## [5,] -0.295563353 0.175875207 0.0213381246 -0.1831721870 -0.069555077
## [6,] 0.759964390 -0.172494278 0.1112266280 -0.0946707936 -0.119376175
## [7,] -0.172494278 0.825316571 -0.2777024895 -0.0239108433 -0.013850235
## [8,] 0.111226628 -0.277702490 0.7798935957 -0.0908552246 0.001651528
## [9,] -0.094670794 -0.023910843 -0.0908552246 0.8397509853 -0.187173857
## [10,] -0.119376175 -0.013850235 0.0016515279 -0.1871738572 0.805196294
## [11,] -0.057176529 -0.027833107 -0.1873014732 -0.0314976276 -0.274391114
## [12,] -0.017756079 -0.050798146 0.0422345316 -0.0465004667 -0.007396474
## [13,] -0.001124564 -0.019888296 -0.0359441540 0.0419612684 0.009930645
## [14,] -0.015250224 0.007837294 -0.0151717627 0.0015592884 -0.012783965
## [15,] -0.050236514 -0.002297959 -0.0001400221 -0.0828788820 -0.023642421
## [16,] 0.008871472 -0.035835431 -0.0144077592 -0.0034303982 -0.047462449
## [,11] [,12] [,13] [,14] [,15]
## [1,] 0.08043134 -0.305408832 0.029004783 0.023715253 0.0517270282
## [2,] -0.04385267 -0.018474568 -0.092586263 -0.015843411 0.0067359237
## [3,] -0.03177511 0.059301128 -0.007803574 -0.043180658 0.0012484152
## [4,] -0.15075984 0.034365540 -0.025289261 -0.015711612 0.0035951429
## [5,] 0.05981701 -0.021519629 0.018691558 -0.011972501 -0.0260039469
## [6,] -0.05717653 -0.017756079 -0.001124564 -0.015250224 -0.0502365145
## [7,] -0.02783311 -0.050798146 -0.019888296 0.007837294 -0.0022979586
## [8,] -0.18730147 0.042234532 -0.035944154 -0.015171763 -0.0001400221
## [9,] -0.03149763 -0.046500467 0.041961268 0.001559288 -0.0828788820
## [10,] -0.27439111 -0.007396474 0.009930645 -0.012783965 -0.0236424211
## [11,] 0.79648000 0.091805364 -0.050035714 -0.018031029 -0.0493690630
## [12,] 0.09180536 0.804749866 -0.282239536 -0.056397079 -0.2440624532
## [13,] -0.05003571 -0.282239536 0.809408564 -0.393925191 -0.0541606552
## [14,] -0.01803103 -0.056397079 -0.393925191 0.829039212 -0.1199024147
## [15,] -0.04936906 -0.244062453 -0.054160655 -0.119902415 0.8358742410
## [16,] -0.11201971 -0.079624525 -0.083160959 -0.146818214 -0.3147619774
## [,16]
## [1,] 0.023535609
## [2,] 0.039919432
## [3,] -0.070417730
## [4,] 0.027315750
## [5,] 0.012706666
## [6,] 0.008871472
## [7,] -0.035835431
## [8,] -0.014407759
## [9,] -0.003430398
## [10,] -0.047462449
## [11,] -0.112019713
## [12,] -0.079624525
## [13,] -0.083160959
## [14,] -0.146818214
## [15,] -0.314761977
## [16,] 0.847470610Overall KMO and individual KMO is more than 0.5 hence we can use it for the analysis
Lets see the determinant of correlation matrix.
det(raqmatrix)## [1] 0.02298935It is more than 0.00001 Now Extracting Factors. First set number of factors equal to that of variables.
pc1 <- principal(raqData,nfactors=16,rotate="none")
pc1## Principal Components Analysis
## Call: principal(r = raqData, nfactors = 16, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11
## q14_1 0.57 0.15 0.23 -0.50 0.16 -0.17 -0.10 -0.07 0.21 -0.15 -0.04
## q14_2 0.53 0.24 0.05 -0.38 -0.37 0.08 -0.15 -0.21 0.26 0.42 0.11
## q14_3 0.47 0.31 -0.06 -0.09 -0.57 0.12 0.38 -0.18 -0.17 -0.21 -0.08
## q14_4 0.49 0.51 -0.19 -0.02 0.28 0.32 0.17 0.02 0.08 -0.30 -0.09
## q14_5 0.27 -0.09 0.67 0.00 0.20 0.50 0.12 0.17 0.12 0.01 0.15
## q14_6 0.44 -0.06 0.58 -0.04 -0.24 -0.11 -0.02 0.47 -0.19 0.08 -0.14
## q14_7 0.57 0.38 -0.14 -0.14 0.09 -0.39 0.02 0.28 -0.27 -0.03 0.14
## q14_8 0.49 0.49 -0.29 0.11 0.33 0.04 -0.04 0.06 -0.05 0.26 0.20
## q14_9 0.43 0.03 0.46 0.26 0.28 -0.11 0.13 -0.48 -0.35 0.20 -0.13
## q14_10 0.43 0.06 0.30 0.53 -0.18 -0.16 -0.33 -0.16 0.11 -0.33 0.33
## q14_11 0.47 0.27 -0.14 0.56 -0.10 0.04 -0.21 0.13 0.23 0.11 -0.42
## q15_1 0.59 -0.42 0.00 -0.31 0.20 -0.18 -0.10 -0.11 0.13 -0.19 -0.16
## q15_2 0.60 -0.39 -0.29 -0.11 -0.01 0.21 -0.29 -0.02 -0.19 -0.02 -0.07
## q15_3 0.56 -0.42 -0.28 0.01 -0.07 0.30 -0.17 0.02 -0.31 0.00 0.10
## q15_4 0.56 -0.46 -0.10 0.15 0.07 -0.14 0.32 0.01 0.19 0.09 -0.08
## q15_5 0.54 -0.38 -0.23 0.25 -0.05 -0.11 0.36 0.10 0.19 0.07 0.24
## PC12 PC13 PC14 PC15 PC16 h2 u2 com
## q14_1 -0.29 -0.16 0.04 0.20 -0.26 1 0.0e+00 5.4
## q14_2 0.05 -0.08 -0.01 -0.19 0.12 1 -1.6e-15 6.3
## q14_3 0.07 0.16 0.05 0.18 -0.05 1 8.9e-16 5.2
## q14_4 0.00 -0.20 -0.21 -0.24 0.11 1 -4.4e-16 6.4
## q14_5 0.04 0.18 0.25 -0.01 -0.01 1 -1.1e-15 3.5
## q14_6 0.02 -0.08 -0.31 0.03 0.04 1 -2.2e-16 4.6
## q14_7 0.02 0.04 0.33 -0.22 0.04 1 0.0e+00 5.6
## q14_8 0.18 0.14 -0.18 0.32 -0.04 1 -2.2e-16 6.4
## q14_9 -0.12 -0.01 -0.02 -0.08 0.01 1 8.9e-16 6.3
## q14_10 0.12 -0.05 -0.05 -0.02 -0.01 1 -4.4e-16 6.3
## q14_11 -0.14 0.06 0.18 0.05 0.02 1 -8.9e-16 5.3
## q15_1 0.13 0.25 -0.03 0.09 0.34 1 -2.2e-16 5.4
## q15_2 0.04 0.23 -0.11 -0.22 -0.32 1 -6.7e-16 5.4
## q15_3 -0.13 -0.32 0.13 0.19 0.17 1 -4.4e-16 6.1
## q15_4 0.39 -0.26 0.09 0.00 -0.16 1 -6.7e-16 5.3
## q15_5 -0.40 0.14 -0.13 -0.06 0.03 1 1.1e-16 6.3
##
## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10
## SS loadings 4.11 1.77 1.54 1.29 0.95 0.81 0.75 0.71 0.68 0.62
## Proportion Var 0.26 0.11 0.10 0.08 0.06 0.05 0.05 0.04 0.04 0.04
## Cumulative Var 0.26 0.37 0.46 0.54 0.60 0.65 0.70 0.75 0.79 0.83
## Proportion Explained 0.26 0.11 0.10 0.08 0.06 0.05 0.05 0.04 0.04 0.04
## Cumulative Proportion 0.26 0.37 0.46 0.54 0.60 0.65 0.70 0.75 0.79 0.83
## PC11 PC12 PC13 PC14 PC15 PC16
## SS loadings 0.54 0.52 0.47 0.44 0.43 0.38
## Proportion Var 0.03 0.03 0.03 0.03 0.03 0.02
## Cumulative Var 0.86 0.89 0.92 0.95 0.98 1.00
## Proportion Explained 0.03 0.03 0.03 0.03 0.03 0.02
## Cumulative Proportion 0.86 0.89 0.92 0.95 0.98 1.00
##
## Mean item complexity = 5.6
## Test of the hypothesis that 16 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0
## with the empirical chi square 0 with prob < NA
##
## Fit based upon off diagonal values = 1SS loading or eigen values suggests that only first three components are sufficient. Also fit based on off diagonal values is greater than 0.96 Scree plot
plot(pc1$values,type="b")
Screeplot suggests 6. Rerunning the analysis with 4 factors
pc2 <- principal(raqData, nfactors = 4, rotate = "none")
pc2## Principal Components Analysis
## Call: principal(r = raqData, nfactors = 4, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 PC3 PC4 h2 u2 com
## q14_1 0.57 0.15 0.23 -0.50 0.64 0.36 2.5
## q14_2 0.53 0.24 0.05 -0.38 0.48 0.52 2.3
## q14_3 0.47 0.31 -0.06 -0.09 0.33 0.67 1.9
## q14_4 0.49 0.51 -0.19 -0.02 0.53 0.47 2.3
## q14_5 0.27 -0.09 0.67 0.00 0.54 0.46 1.4
## q14_6 0.44 -0.06 0.58 -0.04 0.54 0.46 1.9
## q14_7 0.57 0.38 -0.14 -0.14 0.52 0.48 2.0
## q14_8 0.49 0.49 -0.29 0.11 0.58 0.42 2.7
## q14_9 0.43 0.03 0.46 0.26 0.46 0.54 2.6
## q14_10 0.43 0.06 0.30 0.53 0.56 0.44 2.6
## q14_11 0.47 0.27 -0.14 0.56 0.62 0.38 2.6
## q15_1 0.59 -0.42 0.00 -0.31 0.62 0.38 2.4
## q15_2 0.60 -0.39 -0.29 -0.11 0.61 0.39 2.3
## q15_3 0.56 -0.42 -0.28 0.01 0.56 0.44 2.4
## q15_4 0.56 -0.46 -0.10 0.15 0.56 0.44 2.2
## q15_5 0.54 -0.38 -0.23 0.25 0.55 0.45 2.7
##
## PC1 PC2 PC3 PC4
## SS loadings 4.11 1.77 1.54 1.29
## Proportion Var 0.26 0.11 0.10 0.08
## Cumulative Var 0.26 0.37 0.46 0.54
## Proportion Explained 0.47 0.20 0.18 0.15
## Cumulative Proportion 0.47 0.67 0.85 1.00
##
## Mean item complexity = 2.3
## Test of the hypothesis that 4 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.08
## with the empirical chi square 8107.87 with prob < 0
##
## Fit based upon off diagonal values = 0.89Lets see if the factors are correct, we find the corr matrix from pc2
loadings <- factor.model(pc2$loadings)
communality <- diag(loadings)
communality## q14_1 q14_2 q14_3 q14_4 q14_5 q14_6 q14_7
## 0.6446087 0.4761285 0.3304716 0.5288046 0.5361628 0.5428407 0.5163795
## q14_8 q14_9 q14_10 q14_11 q15_1 q15_2 q15_3
## 0.5799043 0.4633440 0.5616851 0.6240027 0.6210697 0.6099338 0.5606553
## q15_4 q15_5
## 0.5617622 0.5502189The diagonals of this matrix contains the communalities after extraction. Lets see the difference it is called residual
residuals <- factor.residuals(raqmatrix,pc2$loadings)
uniqueness <- diag(residuals)
uniqueness## q14_1 q14_2 q14_3 q14_4 q14_5 q14_6 q14_7
## 0.3553913 0.5238715 0.6695284 0.4711954 0.4638372 0.4571593 0.4836205
## q14_8 q14_9 q14_10 q14_11 q15_1 q15_2 q15_3
## 0.4200957 0.5366560 0.4383149 0.3759973 0.3789303 0.3900662 0.4393447
## q15_4 q15_5
## 0.4382378 0.4497811The diagonal of this matrix is the uniqueness.
residuals<-as.matrix(residuals[upper.tri(residuals)])This command re-creates the object residuals by using only the upper triangle of the original matrix. We now have an object called residuals that contains the residuals stored in a column. This is handy because it makes it easy to calculate various things.
large.resid<-abs(residuals) > 0.05
# proportion of the large residuals
sum(large.resid)/nrow(residuals)## [1] 0.4583333Some other residuals stats, such as the mean, are skipped here.
Rotation
Orthogonal Rotation
We can set rotate=“varimax” in the principal() function. But there are too many things to see.
print.psych() command prints the factor loading matrix associated with the model pc3, but displaying only loadings above .3 (cut = 0.3) and sorting items by the size of their loadings (sort = TRUE).
pc3 <- principal(raqData, nfactors=4, rotate="equimax")## Specified rotation not found, rotate='none' usedpc3## Principal Components Analysis
## Call: principal(r = raqData, nfactors = 4, rotate = "equimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 PC3 PC4 h2 u2 com
## q14_1 0.57 0.15 0.23 -0.50 0.64 0.36 2.5
## q14_2 0.53 0.24 0.05 -0.38 0.48 0.52 2.3
## q14_3 0.47 0.31 -0.06 -0.09 0.33 0.67 1.9
## q14_4 0.49 0.51 -0.19 -0.02 0.53 0.47 2.3
## q14_5 0.27 -0.09 0.67 0.00 0.54 0.46 1.4
## q14_6 0.44 -0.06 0.58 -0.04 0.54 0.46 1.9
## q14_7 0.57 0.38 -0.14 -0.14 0.52 0.48 2.0
## q14_8 0.49 0.49 -0.29 0.11 0.58 0.42 2.7
## q14_9 0.43 0.03 0.46 0.26 0.46 0.54 2.6
## q14_10 0.43 0.06 0.30 0.53 0.56 0.44 2.6
## q14_11 0.47 0.27 -0.14 0.56 0.62 0.38 2.6
## q15_1 0.59 -0.42 0.00 -0.31 0.62 0.38 2.4
## q15_2 0.60 -0.39 -0.29 -0.11 0.61 0.39 2.3
## q15_3 0.56 -0.42 -0.28 0.01 0.56 0.44 2.4
## q15_4 0.56 -0.46 -0.10 0.15 0.56 0.44 2.2
## q15_5 0.54 -0.38 -0.23 0.25 0.55 0.45 2.7
##
## PC1 PC2 PC3 PC4
## SS loadings 4.11 1.77 1.54 1.29
## Proportion Var 0.26 0.11 0.10 0.08
## Cumulative Var 0.26 0.37 0.46 0.54
## Proportion Explained 0.47 0.20 0.18 0.15
## Cumulative Proportion 0.47 0.67 0.85 1.00
##
## Mean item complexity = 2.3
## Test of the hypothesis that 4 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.08
## with the empirical chi square 8107.87 with prob < 0
##
## Fit based upon off diagonal values = 0.89print.psych(pc3, cut = 0.3)## Principal Components Analysis
## Call: principal(r = raqData, nfactors = 4, rotate = "equimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 PC3 PC4 h2 u2 com
## q14_1 0.57 -0.50 0.64 0.36 2.5
## q14_2 0.53 -0.38 0.48 0.52 2.3
## q14_3 0.47 0.31 0.33 0.67 1.9
## q14_4 0.49 0.51 0.53 0.47 2.3
## q14_5 0.67 0.54 0.46 1.4
## q14_6 0.44 0.58 0.54 0.46 1.9
## q14_7 0.57 0.38 0.52 0.48 2.0
## q14_8 0.49 0.49 0.58 0.42 2.7
## q14_9 0.43 0.46 0.46 0.54 2.6
## q14_10 0.43 0.53 0.56 0.44 2.6
## q14_11 0.47 0.56 0.62 0.38 2.6
## q15_1 0.59 -0.42 -0.31 0.62 0.38 2.4
## q15_2 0.60 -0.39 0.61 0.39 2.3
## q15_3 0.56 -0.42 0.56 0.44 2.4
## q15_4 0.56 -0.46 0.56 0.44 2.2
## q15_5 0.54 -0.38 0.55 0.45 2.7
##
## PC1 PC2 PC3 PC4
## SS loadings 4.11 1.77 1.54 1.29
## Proportion Var 0.26 0.11 0.10 0.08
## Cumulative Var 0.26 0.37 0.46 0.54
## Proportion Explained 0.47 0.20 0.18 0.15
## Cumulative Proportion 0.47 0.67 0.85 1.00
##
## Mean item complexity = 2.3
## Test of the hypothesis that 4 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.08
## with the empirical chi square 8107.87 with prob < 0
##
## Fit based upon off diagonal values = 0.89The three factors extracted together account of 80% of the variance. Factor 1 is a combination of Online, Food and Airyoung. We can calssify it as “Customer Service”
Factor 2 is a combination of Hostess, frqufly and Lifestyle. This can by classified as “Flyer incentive”.
Factor 3 is a combination of “Comfort and schedule”. We can classify it as “Convenience”
head(pc2$scores) # access scores by pc2$scores## PC1 PC2 PC3 PC4
## [1,] -0.5195021 1.3681257 0.03117359 -0.11269996
## [2,] -0.3385209 3.9206210 1.98438938 -0.75393378
## [3,] -0.4072544 0.9633673 1.38383019 0.06488939
## [4,] -1.3509058 1.3846156 0.80950796 -0.62100340
## [5,] 0.7831115 1.5704635 0.88248410 1.65750672
## [6,] -0.2511113 -0.1485034 0.52477794 3.39457179raqData1 <- cbind(raqData[,1:10], pc2$scores)
# bind the factor scores to raqData dataframe for other use
head(raqData1)## q14_1 q14_2 q14_3 q14_4 q14_5 q14_6 q14_7 q14_8 q14_9 q14_10
## [1,] 3 3 4 5 5 4 5 4 3 4
## [2,] 5 5 5 5 4 4 4 5 5 5
## [3,] 3 3 4 4 5 5 4 5 5 4
## [4,] 3 3 5 4 5 3 3 3 4 3
## [5,] 3 4 4 5 5 5 5 5 5 5
## [6,] 1 2 3 4 5 4 5 4 5 5
## PC1 PC2 PC3 PC4
## [1,] -0.5195021 1.3681257 0.03117359 -0.11269996
## [2,] -0.3385209 3.9206210 1.98438938 -0.75393378
## [3,] -0.4072544 0.9633673 1.38383019 0.06488939
## [4,] -1.3509058 1.3846156 0.80950796 -0.62100340
## [5,] 0.7831115 1.5704635 0.88248410 1.65750672
## [6,] -0.2511113 -0.1485034 0.52477794 3.39457179biplot.psych(pc2)