Factor Analysis of 50 item personality test

factorAnalysisExampleFromJeromyAnglimBlog.r

# Example from: http://jeromyanglim.blogspot.com/2009/10/factor-analysis-in-r.html
# Jeromy Anglim

# Required packages.
require(psych);
require(foreign);

# Import data from SPSS data file.
personality <- foreign::read.spss("spss\\personality.sav", 
    to.data.frame = TRUE)

# Factor analysis.
items <- c("ipip1", "ipip2", "ipip3", "ipip4", "ipip5", 
    "ipip6", "ipip7", "ipip8", "ipip9", "ipip10", "ipip11", 
    "ipip12", "ipip13", "ipip14", "ipip15", "ipip16", "ipip17", 
    "ipip18", "ipip19", "ipip20", "ipip21", "ipip22", "ipip23", 
    "ipip24", "ipip25", "ipip26", "ipip27", "ipip28", "ipip29", 
    "ipip30", "ipip31", "ipip32", "ipip33", "ipip34", "ipip35", 
    "ipip36", "ipip37", "ipip38", "ipip39", "ipip40", "ipip41", 
    "ipip42", "ipip43", "ipip44", "ipip45", "ipip46", "ipip47", 
    "ipip48", "ipip49", "ipip50") ;

# Descriptive Statistics.
itemDescriptiveStatistics <- sapply(personality[items], 
    function(x) c(mean=mean(x), sd=sd(x), n = length(x)));
cbind(attr(personality, "variable.labels")[items], 
    round(t(itemDescriptiveStatistics), 2) );

# Scree plot.
psych::VSS.scree(cor(personality[items]));

# Some other indicators of the number of factors.
psych::VSS(cor(personality[items]), 10, 
    n.obs = nrow(personality), rotate = "promax");

# Communalities
itemCommunalities <- 1 - dataForScreePlot$uniquenesses;
round(cbind(itemCommunalities), 2);

# List items with low communalities.
itemsWithLowCommunalities <- names(itemCommunalities[
        itemCommunalities < .25]);
cat("Items with low communalities (< .25)\n");
problematicItemText <- attr(personality, 
    "variable.labels")[itemsWithLowCommunalities ];
problematicItemCommunalities <- round(itemCommunalities[
        itemsWithLowCommunalities],3);
data.frame(itemText = problematicItemText, 
    communality = problematicItemCommunalities);


# Variance explained by each factor before rotation. 
# (see Proportion Var)
factanal(personality[items], factors = 5, rotation = "none");

# Variance explained by each factor after rotatoin. 
# (see Proportion Var)
factanal(personality[items], factors = 5, rotation = "promax");

# Loadings prior to rotation.
fitNoRotation <- factanal(personality[items], 
    factors = 5, rotation = "none");
print(fitNoRotation$loadings, cutoff = .30, sort = TRUE);

# Loadings after rotation.
fitAfterRotation <- factanal(personality[items], 
    factors = 5, rotation = "promax");
print(fitAfterRotation$loadings, cutoff = .30, sort = TRUE);

# Correlations between factors 
# This assumes use of a correlated rotation method such as promax
factorCorrelationsRegression <- cor(factanal(
        personality[items],  factors = 5, 
        rotation = "promax", scores = "regression")$scores);
round(factorCorrelationsRegression,2);