Explolatory Factor
Les
2025-11-30
#Packages to install
#install.packages("psych")
#install.packages("GPArotation")
library("psych")## Warning: package 'psych' was built under R version 4.5.2library("GPArotation")## Warning: package 'GPArotation' was built under R version 4.5.2##
## Attaching package: 'GPArotation'## The following objects are masked from 'package:psych':
##
## equamax, varimin#Getting the data into R
Data <- read.csv("C:\\Users\\lesle\\OneDrive\\Документы\\R\\FaDataset.csv", header = TRUE)
names(Data)## [1] "Obs" "Form.of.letter.of.application"
## [3] "Appearance" "Academic.ability"
## [5] "Likeability" "Self.confidence"
## [7] "Lucidity" "Honesty"
## [9] "Salesmanship" "Experience"
## [11] "Drive" "Ambition"
## [13] "Grasp" "Potential"
## [15] "Keeness.to.join" "Suitability"options(scipen = 999)
#Overall Raw Score – determine top 3
Data$OverallRaw <- rowSums(Data[ , c(
"Form.of.letter.of.application",
"Appearance",
"Academic.ability",
"Likeability",
"Self.confidence",
"Lucidity",
"Honesty",
"Salesmanship",
"Experience",
"Drive",
"Ambition",
"Grasp",
"Potential",
"Keeness.to.join",
"Suitability"
)])
#Create data frame with assignment 2 variables
DataFrame <- Data[, c("Form.of.letter.of.application", "Appearance", "Academic.ability", "Likeability",
"Self.confidence", "Lucidity", "Honesty", "Salesmanship", "Experience", "Drive", "Ambition", "Grasp", "Potential",
"Keeness.to.join", "Suitability")]
#Screen Plot
ScreePlot <- scree(DataFrame, factors = TRUE, main = "Scree plot", hline = NULL, add = FALSE)
#Eigen Values Total Variance Explained
ev <- eigen(cor(DataFrame))
summary(ev)## Length Class Mode
## values 15 -none- numeric
## vectors 225 -none- numericev$values## [1] 7.51379418 2.05630117 1.45581948 1.19789771 0.73915262 0.49457907
## [7] 0.35126183 0.30990202 0.25696154 0.18491037 0.15268036 0.09756308
## [13] 0.08881880 0.06463323 0.03572455cumsum(ev$values)/15## [1] 0.5009196 0.6380064 0.7350610 0.8149208 0.8641977 0.8971696 0.9205871
## [8] 0.9412472 0.9583780 0.9707053 0.9808840 0.9873882 0.9933095 0.9976184
## [15] 1.0000000#Running Ortho FA (where the X is you will need to input the number of factors you would like to extract based on the Scree Plot and Eigenvalues– this is up to you to decide!).
ORTHOFA <- factanal(DataFrame, factors = 3, rotation = "varimax", fm="pa")
print(ORTHOFA, digits=3, cutoff=.1, sort=TRUE)##
## Call:
## factanal(x = DataFrame, factors = 3, rotation = "varimax", fm = "pa")
##
## Uniquenesses:
## Form.of.letter.of.application Appearance
## 0.536 0.699
## Academic.ability Likeability
## 0.944 0.005
## Self.confidence Lucidity
## 0.117 0.198
## Honesty Salesmanship
## 0.442 0.145
## Experience Drive
## 0.356 0.239
## Ambition Grasp
## 0.155 0.198
## Potential Keeness.to.join
## 0.178 0.419
## Suitability
## 0.191
##
## Loadings:
## Factor1 Factor2 Factor3
## Self.confidence 0.925 0.135
## Lucidity 0.833 0.120 0.307
## Salesmanship 0.872 0.270 0.149
## Drive 0.763 0.381 0.187
## Ambition 0.891 0.174 0.144
## Grasp 0.790 0.286 0.311
## Potential 0.720 0.358 0.420
## Form.of.letter.of.application 0.120 0.644 0.189
## Experience 0.799
## Suitability 0.333 0.824 0.137
## Likeability 0.202 0.155 0.964
## Honesty 0.274 -0.242 0.651
## Keeness.to.join 0.440 0.221 0.582
## Appearance 0.441 0.182 0.272
## Academic.ability 0.224
##
## Factor1 Factor2 Factor3
## SS loadings 5.464 2.428 2.286
## Proportion Var 0.364 0.162 0.152
## Cumulative Var 0.364 0.526 0.679
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 128.86 on 63 degrees of freedom.
## The p-value is 0.00000198#Create Ortho Factor Average Variables – You will create one new variable for each factor that you have kept. You will
#Create Ortho Factor Data Frames (to be used for reliability analysis)
# Ortho Factor 1 – main "motivation/drive" factor
Ortho1_DataFrame <- Data[, c(
"Self.confidence",
"Salesmanship",
"Ambition",
"Lucidity",
"Grasp",
"Drive",
"Potential"
)]
# Ortho Factor 2 – "application & suitability" factor
Ortho2_DataFrame <- Data[, c(
"Form.of.letter.of.application",
"Experience",
"Suitability"
)]
# Ortho Factor 3 – "personal integrity & fit" factor
Ortho3_DataFrame <- Data[, c(
"Likeability",
"Honesty",
"Keeness.to.join"
)]
#Factor Reliability Analysis – only need to interpret the “Raw Alpha” value
alpha(Ortho1_DataFrame)## Number of categories should be increased in order to count frequencies.##
## Reliability analysis
## Call: alpha(x = Ortho1_DataFrame)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.96 0.96 0.97 0.78 25 0.0086 5.9 2.7 0.78
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.94 0.96 0.98
## Duhachek 0.94 0.96 0.98
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## Self.confidence 0.96 0.96 0.96 0.79 23 0.0096 0.0028 0.78
## Salesmanship 0.95 0.95 0.96 0.77 20 0.0107 0.0040 0.78
## Ambition 0.95 0.95 0.96 0.77 21 0.0104 0.0040 0.78
## Lucidity 0.95 0.95 0.96 0.78 21 0.0102 0.0034 0.78
## Grasp 0.95 0.95 0.96 0.78 21 0.0104 0.0028 0.78
## Drive 0.96 0.96 0.97 0.79 23 0.0095 0.0033 0.78
## Potential 0.95 0.96 0.96 0.78 22 0.0099 0.0032 0.78
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Self.confidence 48 0.87 0.88 0.86 0.83 6.9 2.4
## Salesmanship 48 0.93 0.92 0.91 0.89 4.9 3.4
## Ambition 48 0.92 0.92 0.91 0.88 6.0 2.9
## Lucidity 48 0.91 0.91 0.90 0.87 6.3 3.2
## Grasp 48 0.92 0.91 0.91 0.88 6.2 3.0
## Drive 48 0.87 0.87 0.84 0.83 5.3 2.9
## Potential 48 0.90 0.89 0.88 0.86 5.7 3.2alpha(Ortho2_DataFrame)## Number of categories should be increased in order to count frequencies.##
## Reliability analysis
## Call: alpha(x = Ortho2_DataFrame)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.82 0.82 0.76 0.61 4.7 0.043 5.4 2.7 0.59
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.71 0.82 0.89
## Duhachek 0.74 0.82 0.91
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N
## Form.of.letter.of.application 0.82 0.82 0.69 0.69 4.5
## Experience 0.73 0.74 0.59 0.59 2.8
## Suitability 0.70 0.71 0.55 0.55 2.4
## alpha se var.r med.r
## Form.of.letter.of.application 0.052 NA 0.69
## Experience 0.076 NA 0.59
## Suitability 0.084 NA 0.55
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Form.of.letter.of.application 48 0.80 0.83 0.67 0.62 6.0 2.7
## Experience 48 0.88 0.87 0.78 0.70 4.2 3.3
## Suitability 48 0.89 0.88 0.81 0.73 6.0 3.3alpha(Ortho3_DataFrame)## Number of categories should be increased in order to count frequencies.##
## Reliability analysis
## Call: alpha(x = Ortho3_DataFrame)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.82 0.81 0.77 0.59 4.4 0.046 6.6 2.3 0.65
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.70 0.82 0.89
## Duhachek 0.72 0.82 0.91
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## Likeability 0.62 0.62 0.45 0.45 1.6 0.110 NA 0.45
## Honesty 0.81 0.81 0.69 0.69 4.4 0.054 NA 0.69
## Keeness.to.join 0.78 0.78 0.65 0.65 3.6 0.062 NA 0.65
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Likeability 48 0.92 0.91 0.86 0.78 6.1 2.8
## Honesty 48 0.81 0.82 0.67 0.60 8.0 2.5
## Keeness.to.join 48 0.84 0.83 0.71 0.63 5.6 2.7#Ortho Overall Score
Data$OrthoFA1 <- rowMeans(Data[, c(
"Self.confidence",
"Salesmanship",
"Ambition",
"Lucidity",
"Grasp",
"Drive",
"Potential"
)])
Data$OrthoFA2 <- rowMeans(Data[, c(
"Form.of.letter.of.application",
"Experience",
"Suitability"
)])
Data$OrthoFA3 <- rowMeans(Data[, c(
"Likeability",
"Honesty",
"Keeness.to.join"
)])
names(Data)## [1] "Obs" "Form.of.letter.of.application"
## [3] "Appearance" "Academic.ability"
## [5] "Likeability" "Self.confidence"
## [7] "Lucidity" "Honesty"
## [9] "Salesmanship" "Experience"
## [11] "Drive" "Ambition"
## [13] "Grasp" "Potential"
## [15] "Keeness.to.join" "Suitability"
## [17] "OverallRaw" "OrthoFA1"
## [19] "OrthoFA2" "OrthoFA3"length(Data$OrthoFA1)## [1] 48length(Data$OrthoFA2)## [1] 48length(Data$OrthoFA3)## [1] 48Data$Ortho_Overall <- Data$OrthoFA1 +
Data$OrthoFA2 +
Data$OrthoFA3 +
Data$Appearance +
Data$Academic.ability
#Running Ortho FA (where the X is you will need to input the number of factors you would like to extract based on the Scree Plot and Eigenvalues– this is up to you to decide!).
OBLIQFA <- factanal(DataFrame,
factors = 3,
rotation = "oblimin")
print(OBLIQFA, digits = 3, cutoff = .1, sort = TRUE)##
## Call:
## factanal(x = DataFrame, factors = 3, rotation = "oblimin")
##
## Uniquenesses:
## Form.of.letter.of.application Appearance
## 0.536 0.699
## Academic.ability Likeability
## 0.944 0.005
## Self.confidence Lucidity
## 0.117 0.198
## Honesty Salesmanship
## 0.442 0.145
## Experience Drive
## 0.356 0.239
## Ambition Grasp
## 0.155 0.198
## Potential Keeness.to.join
## 0.178 0.419
## Suitability
## 0.191
##
## Loadings:
## Factor1 Factor2 Factor3
## Self.confidence 1.013 -0.251
## Lucidity 0.831 0.140
## Salesmanship 0.896 0.135
## Drive 0.746 0.265
## Ambition 0.932
## Grasp 0.758 0.153 0.147
## Potential 0.639 0.232 0.279
## Form.of.letter.of.application 0.639 0.149
## Experience 0.822
## Suitability 0.213 0.798
## Likeability 1.008
## Honesty 0.168 -0.341 0.665
## Keeness.to.join 0.303 0.120 0.528
## Appearance 0.393 0.102 0.189
## Academic.ability 0.228
##
## Factor1 Factor2 Factor3
## SS loadings 5.254 2.15 1.933
##
## Factor Correlations:
## Factor1 Factor2 Factor3
## Factor1 1.000 0.316 0.454
## Factor2 0.316 1.000 0.209
## Factor3 0.454 0.209 1.000
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 128.86 on 63 degrees of freedom.
## The p-value is 0.00000198#Create Oblique Factor Average Variables – You will create one new variable for each factor that you have kept. You will need to add in the specific variables that are loading on each factor in the parentheses and update number you will divide by to get your average (X is in there as placeholder).
Data$ObliqFA1 <- rowMeans(Data[, c(
"Self.confidence",
"Salesmanship",
"Ambition",
"Lucidity",
"Grasp",
"Drive",
"Potential"
)])
Data$ObliqFA2 <- rowMeans(Data[, c(
"Form.of.letter.of.application",
"Experience",
"Suitability"
)])
Data$ObliqFA3 <- rowMeans(Data[, c(
"Likeability",
"Honesty",
"Keeness.to.join"
)])
#Create Ortho Factor Data Frames (to be used for reliability analysis)
Obliq1_DataFrame <- Data[, c(
"Self.confidence",
"Salesmanship",
"Ambition",
"Lucidity",
"Grasp",
"Drive",
"Potential"
)]
Obliq2_DataFrame <- Data[, c(
"Form.of.letter.of.application",
"Experience",
"Suitability"
)]
Obliq3_DataFrame <- Data[, c(
"Likeability",
"Honesty",
"Keeness.to.join"
)]
#Factor Reliability Analysis – only need to interpret the “Raw Alpha” value
alpha(Obliq1_DataFrame)## Number of categories should be increased in order to count frequencies.##
## Reliability analysis
## Call: alpha(x = Obliq1_DataFrame)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.96 0.96 0.97 0.78 25 0.0086 5.9 2.7 0.78
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.94 0.96 0.98
## Duhachek 0.94 0.96 0.98
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## Self.confidence 0.96 0.96 0.96 0.79 23 0.0096 0.0028 0.78
## Salesmanship 0.95 0.95 0.96 0.77 20 0.0107 0.0040 0.78
## Ambition 0.95 0.95 0.96 0.77 21 0.0104 0.0040 0.78
## Lucidity 0.95 0.95 0.96 0.78 21 0.0102 0.0034 0.78
## Grasp 0.95 0.95 0.96 0.78 21 0.0104 0.0028 0.78
## Drive 0.96 0.96 0.97 0.79 23 0.0095 0.0033 0.78
## Potential 0.95 0.96 0.96 0.78 22 0.0099 0.0032 0.78
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Self.confidence 48 0.87 0.88 0.86 0.83 6.9 2.4
## Salesmanship 48 0.93 0.92 0.91 0.89 4.9 3.4
## Ambition 48 0.92 0.92 0.91 0.88 6.0 2.9
## Lucidity 48 0.91 0.91 0.90 0.87 6.3 3.2
## Grasp 48 0.92 0.91 0.91 0.88 6.2 3.0
## Drive 48 0.87 0.87 0.84 0.83 5.3 2.9
## Potential 48 0.90 0.89 0.88 0.86 5.7 3.2alpha(Obliq2_DataFrame)## Number of categories should be increased in order to count frequencies.##
## Reliability analysis
## Call: alpha(x = Obliq2_DataFrame)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.82 0.82 0.76 0.61 4.7 0.043 5.4 2.7 0.59
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.71 0.82 0.89
## Duhachek 0.74 0.82 0.91
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N
## Form.of.letter.of.application 0.82 0.82 0.69 0.69 4.5
## Experience 0.73 0.74 0.59 0.59 2.8
## Suitability 0.70 0.71 0.55 0.55 2.4
## alpha se var.r med.r
## Form.of.letter.of.application 0.052 NA 0.69
## Experience 0.076 NA 0.59
## Suitability 0.084 NA 0.55
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Form.of.letter.of.application 48 0.80 0.83 0.67 0.62 6.0 2.7
## Experience 48 0.88 0.87 0.78 0.70 4.2 3.3
## Suitability 48 0.89 0.88 0.81 0.73 6.0 3.3alpha(Obliq3_DataFrame)## Number of categories should be increased in order to count frequencies.##
## Reliability analysis
## Call: alpha(x = Obliq3_DataFrame)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.82 0.81 0.77 0.59 4.4 0.046 6.6 2.3 0.65
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.70 0.82 0.89
## Duhachek 0.72 0.82 0.91
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## Likeability 0.62 0.62 0.45 0.45 1.6 0.110 NA 0.45
## Honesty 0.81 0.81 0.69 0.69 4.4 0.054 NA 0.69
## Keeness.to.join 0.78 0.78 0.65 0.65 3.6 0.062 NA 0.65
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## Likeability 48 0.92 0.91 0.86 0.78 6.1 2.8
## Honesty 48 0.81 0.82 0.67 0.60 8.0 2.5
## Keeness.to.join 48 0.84 0.83 0.71 0.63 5.6 2.7#Oblique Overall Score – After creating your factor averages you will want to create the overall factor score. This will be done by adding all of the Obliq_Factor Variables that you created above. Note, your specific code for doing this will depend on the number of factors you retained and if you decide some variables will not load on a factor. The code below is an example for you to modify.
Data$Obliq_Overall_Score <- Data$ObliqFA1 +
Data$ObliqFA2 +
Data$ObliqFA3 +
Data$Appearance +
Data$Academic.ability
#Determine the top 3 based on the Obliq Overall Score – there is no code for this, you will filter the “Obliq Overall Score”
Data[order(-Data$Obliq_Overall_Score), ][1:3, ]## Obs Form.of.letter.of.application Appearance Academic.ability Likeability
## 8 8 9 9 9 8
## 40 40 10 6 9 10
## 39 39 10 6 9 10
## Self.confidence Lucidity Honesty Salesmanship Experience Drive Ambition
## 8 9 9 8 8 10 9 10
## 40 9 10 10 10 10 10 10
## 39 9 10 10 10 10 10 8
## Grasp Potential Keeness.to.join Suitability OverallRaw OrthoFA1 OrthoFA2
## 8 9 9 9 10 135 9.000000 9.666667
## 40 10 10 10 10 144 9.857143 10.000000
## 39 10 10 10 10 142 9.571429 10.000000
## OrthoFA3 Ortho_Overall ObliqFA1 ObliqFA2 ObliqFA3 Obliq_Overall_Score
## 8 8.333333 45.00000 9.000000 9.666667 8.333333 45.00000
## 40 10.000000 44.85714 9.857143 10.000000 10.000000 44.85714
## 39 10.000000 44.57143 9.571429 10.000000 10.000000 44.57143