### R code from vignette source 'chap10.Rnw'

###################################################
### code chunk number 1: chap10.Rnw:5-6
###################################################
options(show.signif.stars=FALSE,digits=4,width=80)


###################################################
### code chunk number 2: chap10.Rnw:41-46
###################################################
loc <- "http://www.stat.umn.edu/~sandy/courses/8053/Data/uscomp1.dat"
head(uscomp <- read.table(url(loc),header=TRUE))
snames <-c("Com", "Enr", "Fin", "HiTch", "Manu", "Med", "Oth", "Ret", "Tran")
sector <- rep(1:9, c(2 ,15, 17, 8, 10, 4, 7, 10, 6))
print(R <- cor(uscomp[-c(38,40),]), digits=3)


###################################################
### code chunk number 3: chap10.Rnw:49-50
###################################################
(f2 <- factanal(uscomp,factor=2,rotation="none",subset=-c(38,40)))


###################################################
### code chunk number 4: chap10.Rnw:60-63
###################################################
Q <- loadings(f2)
Psi <- diag(f2$uniquenesses)
(sighat <-(Q %*% t(Q) + Psi))


###################################################
### code chunk number 5: chap10.Rnw:66-67
###################################################
round(100*(sighat - R) / R, 1)


###################################################
### code chunk number 6: chap10.Rnw:73-75
###################################################
(f3 <-factanal(uscomp, factor=3, rotation="none", subset=-c(38,40),
      scores="regression"))


###################################################
### code chunk number 7: chap10.Rnw:86-87
###################################################
varimax(loadings(f3))


###################################################
### code chunk number 8: aa
###################################################
pairs(f3$scores)


###################################################
### code chunk number 9: chap10.Rnw:110-112
###################################################
loc<-"http://www.stat.umn.edu/~sandy/courses/8053/Data/officerratings.csv"
data <- read.csv(url(loc),header=TRUE)


###################################################
### code chunk number 10: chap10.Rnw:115-118
###################################################
(names <- data.frame(vname=paste("Q", 1:14, sep=""),
         description=names(data)))
colnames(data) <- names$vname


###################################################
### code chunk number 11: chap10.Rnw:123-124
###################################################
options(width=80)


###################################################
### code chunk number 12: a
###################################################
print(R <- cor(data), digits=2)


###################################################
### code chunk number 13: chap10.Rnw:129-130
###################################################
options(width=60)


###################################################
### code chunk number 14: a
###################################################
hist(R[-14, -14][lower.tri(R[-14, -14])],
     main="Sample Correlations", xlab="r")
box()


###################################################
### code chunk number 15: chap10.Rnw:141-143
###################################################
(f3 <- factanal(~.-Q14, data=data, factors=3, rotation="varimax"))
(f4 <- factanal(~.-Q14, data=data, factors=4, rotation="varimax"))


###################################################
### code chunk number 16: b
###################################################
par(mfrow=c(3,2))
loads <- loadings(f4)
for (j in 1:6) {
 h <- c(1,1,1,2,2,3)[j]
 v <- c(2,3,4,3,4,4)[j]
   plot(loads[,c(h,v)],type="n")
   text(loads[,c(h,v)],rownames(loads)) }


###################################################
### code chunk number 17: c
###################################################
f4 <- update(f4,scores="regression")
pairs(f4$scores)