Revision

**b6fe861fe48f12c1b45d1e68f8508ee6503821ac**authored by Gilles Raiche on**24 April 2007, 00:00 UTC**, committed by Gabor Csardi on**24 April 2007, 00:00 UTC****1 parent**4e9967d

nScree.R

```
"nScree" <-
function(eig,
aparallel = rep(1,length(eig))
) {
# Initialisation
nk <- length(eig)
k <- 1:nk
proportion <- eig/nk
cumulative <- proportion
for (i in 2:nk) cumulative[i] = cumulative[i-1] + proportion[i]
cond1 <- TRUE; cond2 <- TRUE; i <- 0; pred.eig <- af <- rep(NA,nk)
while ((cond1 == TRUE) && (cond2 == TRUE) && (i < nk)) {
i <- i + 1
ind <- k[c(i+1,nk)]
# Optimal coordinate based on the next eigenvalue regression (scree)
vp.p <- lm(eig[c(i+1,nk)] ~ ind)
vp.prec <- pred.eig[i] <- sum(c(1,i)* coef(vp.p))
cond1 <- (eig[i] >= vp.prec)
cond2 <- (eig[i] >= aparallel[i])
nc <- i-1
}
# Second derivative at the i eigenvalue (acceleration factor, elbow)
# See Yakowitz and Szidarovszky (1986, p. 84)
tag <- 1
for (j in 2:(nk-1)) {
if (eig[j-1] >= aparallel[j-1]) {
af[j] <- (eig[j+1] -2* eig[j]) + eig[j-1]
}
}
p.vec <- which(eig >= aparallel,TRUE)
npar <- sum(p.vec == (1:length(p.vec)))
nkaiser <- sum(eig >= rep(1,nk))
naf <- which(af == max(af,na.rm=TRUE),TRUE) - 1
# Assure that all the optimal coordinates will be computed
for (i in (nc+1):(nk-2)) {
ind <- k[c(i+1,nk)]
vp.p <- lm(eig[c(i+1,nk)] ~ ind)
vp.prec <- pred.eig[i] <- sum(c(1,i)* coef(vp.p))
}
# Assure that all the acceleration factors will be computed
for (j in 2:(nk-1)) af[j] <- (eig[j+1] - 2 * eig[j]) + eig[j-1]
# Return values by the function
coc <- rep("",nk); coc[nc] = "(< OC)"
caf <- rep("",nk); caf[naf] = "(< AF)"
result <- (list(Components = data.frame(noc = nc,
naf = naf,
nparallel = npar,
nkaiser = nkaiser),
Analysis = data.frame(Eigenvalues = eig,
Prop = proportion,
Cumu = cumulative,
Par.Analysis = aparallel,
Pred.eig = pred.eig,
OC = coc,
Acc.factor = af,
AF = caf))
)
class(result) <- 'nScree'
return(result)
}
```

Computing file changes ...