Download Exploratory Factor Analysis of Psychological Testing Data and more Study Guides, Projects, Research Descriptive statistics in PDF only on Docsity!
R7: Exploratory Factor Analysis
1. Psychological Testing Data
> data(Harman74.cor) > test.cor <- Harman74.cor$cov[c(6, 7, 9, 10, 12),c(6, 7, 9, 10, 12)] > colnames(test.cor) <- c("PARA","SENT","WORD","ADD","COUNT") > rownames(test.cor) <- colnames(test.cor) > > test.cor PARA SENT WORD ADD COUNT PARA 1.000 0.722 0.714 0.203 0. SENT 0.722 1.000 0.685 0.246 0. WORD 0.714 0.685 1.000 0.170 0. ADD 0.203 0.246 0.170 1.000 0. COUNT 0.095 0.181 0.113 0.585 1. **> image(1:5, 1:5, test.cor, zlim=c(-1,1), col=cm.colors(21))
Plot of correlations - magenta = positive, cyan = negative
> image(1:5, 1:5, test.cor, zlim=c(-1,1), col=grey(0:20/20) )
Similar, with white = +1, black = -**
1b. Principal components analysis
> test.pc <- eigen(test.cor)# Principal components analysis > test.pc$values [1] 2.5875 1.4217 0.4152 0.3111 0. > plot(test.pc$values,type="o", pch=16) > abline(h=1,col="grey")
> test.pc$vectors[,1:2] [,1] [,2] [1,] -0.5345 -0. [2,] -0.5424 -0. [3,] -0.5234 -0. [4,] -0.2971 0. [5,] -0.2406 0.
1c. Exploratory factor analysis – two factors
> test.fa2 <- factanal(covmat = test.cor, factors=2, n.obs=145) > test.fa Call: factanal(factors = 2, covmat = test.cor, n.obs = 145) Uniquenesses: PARA SENT WORD ADD COUNT 0.242 0.300 0.327 0.574 0. Loadings: Factor1 Factor PARA 0. SENT 0.820 0. WORD 0. ADD 0.167 0. COUNT 0. Factor1 Factor SS loadings 2.119 1. Proportion Var 0.424 0. Cumulative Var 0.424 0. Test of the hypothesis that 2 factors are sufficient. The chi square statistic is 0.58 on 1 degree of freedom. The p-value is 0.
1d. One-factor model
**> test.fa1 <- update(test.fa2, factors=1)
shorthand to make minor changes to a model
> test.fa** Call: factanal(factors = 1, covmat = test.cor, n.obs = 145) Uniquenesses: PARA SENT WORD ADD COUNT 0.258 0.294 0.328 0.933 0. Loadings: Factor PARA 0. SENT 0. WORD 0. ADD 0. COUNT 0.
> m1.pc$rotation[,1:3] PC1 PC2 PC v1 0.4168 -0.52292 0. v2 0.3886 -0.50888 0. v3 0.4183 0.01522 -0. v4 0.3944 0.02184 -0. v5 0.4254 0.47017 0. v6 0.4048 0.49581 0.
2b. Factor analysis
> m1.fa1 <- factanal(m1, factors=1) > m1.fa Call: factanal(x = m1, factors = 1) Uniquenesses: v1 v2 v3 v4 v5 v 0.773 0.792 0.733 0.795 0.022 0. Loadings: Factor v1 0. v2 0. v3 0. v4 0. v5 0. v6 0. Factor SS loadings 2. Proportion Var 0. Test of the hypothesis that 1 factor is sufficient. The chi square statistic is 53.43 on 9 degrees of freedom. The p-value is 2.43e-
> m1.fa2 <- factanal(m1, factors=2, rotation="none") > m1.fa Call: factanal(x = m1, factors = 2, rotation = "none") Uniquenesses: v1 v2 v3 v4 v5 v 0.005 0.114 0.642 0.742 0.005 0. Loadings: Factor1 Factor v1 0.853 -0. v2 0.804 -0. v3 0. v4 0. v5 0.857 0. v6 0.796 0. Factor1 Factor SS loadings 3.358 1. Proportion Var 0.560 0. Cumulative Var 0.560 0. Test of the hypothesis that 2 factors are sufficient. The chi square statistic is 23.14 on 4 degrees of freedom. The p-value is 0. > m1.fa3 <- factanal(m1, factors=3, rotation="none") > m1.fa Call: factanal(x = m1, factors = 3, rotation = "none") Uniquenesses: v1 v2 v3 v4 v5 v 0.005 0.101 0.005 0.224 0.084 0. Loadings: Factor1 Factor2 Factor v1 0.808 -0.385 0. v2 0.752 -0.290 0. v3 0.813 -0.229 -0. v4 0.729 -0.139 -0. v5 0.802 0. v6 0.764 0. Factor1 Factor2 Factor SS loadings 3.638 0.980 0. Proportion Var 0.606 0.163 0. Cumulative Var 0.606 0.770 0. The degrees of freedom for the model is 0 and the fit was 0.
3. Girls physical measurements data
Correlation matrix of 8 physical measurements on 305 girls between 7 and 17
> data(Harman23.cor) > girls.cor <- Harman23.cor$cov > girls.cor height arm.span forearm lower.leg weight bitro.diameter height 1.000 0.846 0.805 0.859 0.473 0. arm.span 0.846 1.000 0.881 0.826 0.376 0. forearm 0.805 0.881 1.000 0.801 0.380 0. lower.leg 0.859 0.826 0.801 1.000 0.436 0. weight 0.473 0.376 0.380 0.436 1.000 0. bitro.diameter 0.398 0.326 0.319 0.329 0.762 1. chest.girth 0.301 0.277 0.237 0.327 0.730 0. chest.width 0.382 0.415 0.345 0.365 0.629 0. chest.girth chest.width height 0.301 0. arm.span 0.277 0. forearm 0.237 0. lower.leg 0.327 0. weight 0.730 0. bitro.diameter 0.583 0. chest.girth 1.000 0. chest.width 0.539 1. > image(1:8, 1:8, girls.cor, zlim=c(-1,1), col=cm.colors(21) ) > girls.pc <- eigen(girls.cor) # Principal components analysis > girls.pc$values [1] 4.67288 1.77098 0.48104 0.42144 0.23322 0.18667 0.13730 0. > > plot(girls.pc$values,type="o", pch=16) > abline(h=1,col="grey") > rownames(girls.pc$vectors) <- colnames(girls.cor) >
> girls.pc$vectors[,1:2] [,1] [,2] height -0.3976 -0. arm.span -0.3893 -0. forearm -0.3762 -0. lower.leg -0.3884 -0. weight -0.3507 0. bitro.diameter -0.3119 0. chest.girth -0.2855 0. chest.width -0.3102 0. > girls.fa1 <- factanal(covmat=girls.cor, factors=1, n.obs=305) > girls.fa Call: factanal(factors = 1, covmat = girls.cor, n.obs = 305) Uniquenesses: height arm.span forearm lower.leg weight 0.158 0.135 0.190 0.187 0. bitro.diameter chest.girth chest.width 0.829 0.877 0. Loadings: Factor height 0. arm.span 0. forearm 0. lower.leg 0. weight 0. bitro.diameter 0. chest.girth 0. chest.width 0. Factor SS loadings 4. Proportion Var 0. Test of the hypothesis that 1 factor is sufficient. The chi square statistic is 611.4 on 20 degrees of freedom. The p-value is 1.12e- > > girls.fa2 <- factanal(covmat=girls.cor, factors=2, n.obs=305, rotation="none") > girls.fa Call: factanal(factors = 2, covmat = girls.cor, n.obs = 305, rotation = "none") Uniquenesses: height arm.span forearm lower.leg weight 0.170 0.107 0.166 0.199 0. bitro.diameter chest.girth chest.width 0.364 0.416 0.
Factor1 Factor SS loadings 3.335 2. Proportion Var 0.417 0. Cumulative Var 0.417 0. Test of the hypothesis that 2 factors are sufficient. The chi square statistic is 75.74 on 13 degrees of freedom. The p-value is 6.94e- > > arrows(0, 0, girls.fa2a$loadings[,1], girls.fa2a$loadings[,2], col="red") > identify(girls.fa2a$loadings[,1], girls.fa2a$loadings[,2], rownames(girls.fa2$loadings), col="red") > girls.fa2b <- factanal(covmat=girls.cor, factors=2, n.obs=305, rotation="promax") # Promax rotation > girls.fa2b Call: factanal(factors = 2, covmat = girls.cor, n.obs = 305, rotation = "promax") Uniquenesses: height arm.span forearm lower.leg weight 0.170 0.107 0.166 0.199 0. bitro.diameter chest.girth chest.width 0.364 0.416 0. Loadings: Factor1 Factor height 0. arm.span 0. forearm 0. lower.leg 0. weight 0. bitro.diameter 0. chest.girth 0. chest.width 0.125 0.
Factor1 Factor SS loadings 3.375 2. Proportion Var 0.422 0. Cumulative Var 0.422 0. Test of the hypothesis that 2 factors are sufficient. The chi square statistic is 75.74 on 13 degrees of freedom. The p-value is 6.94e- > > arrows(0, 0, girls.fa2b$loadings[,1], girls.fa2b$loadings[,2], col="blue") > identify(girls.fa2b$loadings[,1], girls.fa2b$loadings[,2], rownames(girls.fa2$loadings), col="blue") > girls.fa3 <- factanal(covmat=girls.cor, factors=3, n.obs=305) > girls.fa Call: factanal(factors = 3, covmat = girls.cor, n.obs = 305) Uniquenesses: height arm.span forearm lower.leg weight 0.127 0.005 0.193 0.157 0. bitro.diameter chest.girth chest.width 0.359 0.411 0. Loadings: Factor1 Factor2 Factor height 0.886 0.267 -0. arm.span 0.937 0.195 0. forearm 0.874 0. lower.leg 0.877 0.230 -0. weight 0.242 0.916 -0. bitro.diameter 0.193 0. chest.girth 0.137 0. chest.width 0.261 0.646 0. Factor1 Factor2 Factor SS loadings 3.379 2.628 0. Proportion Var 0.422 0.329 0. Cumulative Var 0.422 0.751 0.
Note that a factor must be related to at least two variables. Drop all of the weight-related
variables except weight itself:
> girls2.cor <- girls.cor[1:5,1:5] > girls2.fa2 <- factanal(covmat=girls2.cor, factors=2, n.obs=305) > girls2.fa Call: factanal(factors = 2, covmat = girls2.cor, n.obs = 305) Uniquenesses: height arm.span forearm lower.leg weight 0.096 0.077 0.159 0.178 0. Loadings: Factor1 Factor height 0.633 0. arm.span 0.865 0. forearm 0.822 0. lower.leg 0.657 0. weight 0.209 0. Factor1 Factor SS loadings 2.299 1. Proportion Var 0.460 0. Cumulative Var 0.460 0.
Weight has high uniqueness, but not its own factor.
3. Pain Reliever Perceptions Data (from book)
> pain<-read.table("B:\www\S5600S07\Data\PAIN_RELIEF.txt") > colnames(pain) <- c("No Upset Stomach", "No Side Effects", "Stops Pain", "Works Quickly", "Keeps Me Awake", "Limited Relief") > pain.pc <- prcomp(pain, scale=T) > plot(pain.pc$sdev^2, type="o", pch=16) > abline(h=1,col="grey")
> pain.pc$rotation[,1:2] PC1 PC No Upset Stomach 0.4316 -0. No Side Effects 0.3808 -0. Stops Pain 0.4536 0. Works Quickly 0.3828 0. Keeps Me Awake -0.3516 0. Limited Relief -0.4392 -0. > pain.fa<-factanal(pain, factors=2, scores="reg") > pain.fa Call: factanal(x = pain, factors = 2, scores = "reg") Uniquenesses: No Upset Stomach No Side Effects Stops Pain Works Quickly 0.434 0.344 0.346 0. Keeps Me Awake Limited Relief 0.365 0. Loadings: Factor1 Factor No Upset Stomach 0.136 0. No Side Effects 0. Stops Pain 0.802 0. Works Quickly 0. Keeps Me Awake -0. Limited Relief -0. Factor1 Factor SS loadings 1.898 1. Proportion Var 0.316 0. Cumulative Var 0.316 0. Test of the hypothesis that 2 factors are sufficient. The chi square statistic is 3.29 on 4 degrees of freedom. The p-value is 0. > plot(pain.fa$scores)
4. Luxury Car Perceptions (from book)
> source("B:\www\S5600S07\readTri.txt") > colnames(car.cor) <- c("Luxury", "Style", "Reliability", "Fuel Econ", "Safety", "Maintenance", "Quality", "Durable", "Performance") > rownames(car.cor) <- colnames(car.cor) > > car.pc <- eigen(car.cor) > car.pc$values [1] 4.1640 1.5400 0.6857 0.5848 0.5152 0.4781 0.3736 0.3508 0. > plot(car.pc$values,type="o", pch=16) > abline(h=1,col="grey") > factanal(covmat=car.cor, factors=2) Call: factanal(factors = 2, covmat = car.cor) Uniquenesses: Luxury Style Reliability Fuel Econ Safety Maintenance 0.164 0.546 0.440 0.625 0.573 0. Quality Durable Performance 0.359 0.451 0. Loadings: Factor1 Factor Luxury 0. Style 0.644 0. Reliability 0.387 0. Fuel Econ -0.101 0. Safety 0.620 0. Maintenance 0.175 0. Quality 0.454 0. Durable 0.335 0. Performance 0.588 0. Factor1 Factor SS loadings 2.491 2. Proportion Var 0.277 0. Cumulative Var 0.277 0. The degrees of freedom for the model is 19 and the fit was 0.
> rownames(car.pc$vectors) <- colnames(car.cor) > car.pc$vectors[,1:2] [,1] [,2] Luxury -0.3125 0. Style -0.3198 0. Reliability -0.3726 -0. Fuel Econ -0.1894 -0. Safety -0.3158 0. Maintenance -0.3058 -0. Quality -0.3968 -0. Durable -0.3644 -0. Performance -0.3768 0. > varimax(car.pc$vectors[,1:2]) $loadings Loadings: [,1] [,2] Luxury 0. Style 0. Reliability -0. Fuel Econ -0.519 -0. Safety 0. Maintenance -0. Quality -0.371 0. Durable -0. Performance -0.190 0. [,1] [,2] SS loadings 1.000 1. Proportion Var 0.111 0. Cumulative Var 0.111 0. $rotmat [,1] [,2] [1,] 0.7561 -0. [2,] 0.6545 0.
5. Full Psychological Test Battery
> fulltest.cor <- Harman74.cor$cov > image(1:24, 1:24, fulltest.cor, zlim=c(-1,1), col=cm.colors(21))
ObjectNumber 0.115 -0. NumberFigure 0.133 0.180 -0.117 -0. FigureWord -0. Deduction -0.159 -0.196 -0. NumericalPuzzles 0.262 -0. ProblemReasoning -0.149 -0.181 -0. SeriesCompletion -0.128 -0. ArithmeticProblems -0.146 0. > promax(fulltest.pc$vectors[,1:4]) $loadings Loadings: [,1] [,2] [,3] [,4] VisualPerception -0. Cubes -0. PaperFormBoard -0.151 -0. Flags -0. GeneralInformation -0. PargraphComprehension -0. SentenceCompletion -0. WordClassification -0. WordMeaning -0. Addition 0.548 0. Code 0.352 0.103 -0. CountingDots 0. StraightCurvedCapitals 0.339 -0.190 0. WordRecognition 0.128 -0. NumberRecognition -0. FigureRecognition -0.118 -0.229 -0. ObjectNumber 0.120 -0. NumberFigure 0.145 0.154 -0.120 -0. FigureWord -0. Deduction -0.153 -0.194 -0. NumericalPuzzles 0.239 -0. ProblemReasoning -0.144 -0.179 -0. SeriesCompletion -0.123 -0. ArithmeticProblems -0.141 0. > fulltest.fa1 <- factanal(covmat = fulltest.cor, factors=1, n.obs=145) > fulltest.fa Call: factanal(factors = 1, covmat = fulltest.cor, n.obs = 145) Uniquenesses: VisualPerception Cubes PaperFormBoard 0.677 0.866 0. Flags GeneralInformation PargraphComprehension 0.768 0.487 0. SentenceCompletion WordClassification WordMeaning 0.500 0.514 0. Addition Code CountingDots 0.818 0.731 0. StraightCurvedCapitals WordRecognition NumberRecognition 0.681 0.833 0. FigureRecognition ObjectNumber NumberFigure
FigureWord Deduction NumericalPuzzles 0.816 0.612 0. ProblemReasoning SeriesCompletion ArithmeticProblems 0.619 0.524 0. Loadings: Factor VisualPerception 0.
Cubes -0.
PaperFormBoard -0.
Flags 0. GeneralInformation 0. PargraphComprehension 0. SentenceCompletion 0. WordClassification 0. WordMeaning 0. Addition 0. Code 0. CountingDots 0. StraightCurvedCapitals 0. WordRecognition 0. NumberRecognition 0. FigureRecognition 0. ObjectNumber 0. NumberFigure 0. FigureWord 0. Deduction 0. NumericalPuzzles 0. ProblemReasoning 0. SeriesCompletion 0. ArithmeticProblems 0. Factor SS loadings 7. Proportion Var 0. Test of the hypothesis that 1 factor is sufficient. The chi square statistic is 622.9 on 252 degrees of freedom. The p-value is 2.28e- > update(fulltest.fa1, factors=2) Test of the hypothesis that 2 factors are sufficient. The chi square statistic is 420.2 on 229 degrees of freedom. The p-value is 2.01e- > update(fulltest.fa1, factors=3) Test of the hypothesis that 3 factors are sufficient. The chi square statistic is 295.6 on 207 degrees of freedom. The p-value is 0. > update(fulltest.fa1, factors=4) Call: factanal(factors = 4, covmat = fulltest.cor, n.obs = 145)
