I try to code the ULS factor analysis descrbied in
ftp://ftp.spss.com/pub/spss/statistics/spss/algorithms/ factor.pdf
# see PP5-6
factanal.fit.uls <- function(cmat, factors, start=NULL, lower = 0.005,
control = NULL, ...)
{
FAfn <- function(Psi, S, q)
{
Sstar <- S - diag(Psi)
E <- eigen(Sstar, symmetric = TRUE, only.values = TRUE)
e <- E$values[-(1:q)]
e <- sum(e^2/2)
e
}
FAgr <- function(Psi, S, q)
{
Sstar <- S - diag(Psi)
E <- eigen(Sstar, symmetric = TRUE)
L <- E$vectors[, -(1:q), drop = FALSE]
e <- E$values[-(1:q)]
gr <- 2*Psi*((L^2)%*%e)
gr
}
p <- ncol(cmat)
if(is.null(start))
start <- (1 - 0.5*factors/p)/diag(solve(cmat))
res <- optim(start, FAfn,
FAgr,
method="L-BFGS-B",
lower = lower, upper = 1,
control = c(list(fnscale=1,
parscale = rep(0.01, length(start))), control),
q = factors, S = cmat)
res
}
covmat <-
structure(c(1, 0.0920030858518061, 0.053952442382614, -0.0380048634941013,
0.237986469993129, 0.243144461077282, 0.0920030858518061, 1,
0.328163804480881, 0.142002180914605, -0.139369611642031, -0.0670944471678571,
0.053952442382614, 0.328163804480881, 1, 0.267648727315665, -0.0549987508157441,
-0.107488501744669, -0.0380048634941013, 0.142002180914605, 0.267648727315665,
1, -0.0566976575082817, -0.132943658387513, 0.237986469993129,
-0.139369611642031, -0.0549987508157441, -0.0566976575082817,
1, 0.352367996102745, 0.243144461077282, -0.0670944471678571,
-0.107488501744669, -0.132943658387513, 0.352367996102745, 1), .Dim = c(6L,
6L), .Dimnames = list(c("bg2cost1", "bg2cost2",
"bg2cost3", "bg2cost4",
"bg2cost5", "bg2cost6"), c("bg2cost1",
"bg2cost2", "bg2cost3",
"bg2cost4", "bg2cost5", "bg2cost6")))
> factanal.fit.uls(covmat,2)
$par
bg2cost1 bg2cost2 bg2cost3 bg2cost4 bg2cost5 bg2cost6
0.7454829 0.7191459 0.6969019 0.7611750 0.6940870 0.6930580
$value
[1] 0.02167674
$counts
function gradient
21 21
$convergence
[1] 52
$message
[1] "ERROR: ABNORMAL_TERMINATION_IN_LNSRCH"
--
Ronggui Huang
Department of Sociology
Fudan University, Shanghai, China
I have not checked your code but that error can stem from an incorrect gradient. On 5/19/07, ronggui <ronggui.huang at gmail.com> wrote:> I try to code the ULS factor analysis descrbied in > ftp://ftp.spss.com/pub/spss/statistics/spss/algorithms/ factor.pdf > # see PP5-6 > > factanal.fit.uls <- function(cmat, factors, start=NULL, lower = 0.005, > control = NULL, ...) > { > FAfn <- function(Psi, S, q) > { > Sstar <- S - diag(Psi) > E <- eigen(Sstar, symmetric = TRUE, only.values = TRUE) > e <- E$values[-(1:q)] > e <- sum(e^2/2) > e > } > > FAgr <- function(Psi, S, q) > { > Sstar <- S - diag(Psi) > E <- eigen(Sstar, symmetric = TRUE) > L <- E$vectors[, -(1:q), drop = FALSE] > e <- E$values[-(1:q)] > gr <- 2*Psi*((L^2)%*%e) > gr > } > > p <- ncol(cmat) > if(is.null(start)) > start <- (1 - 0.5*factors/p)/diag(solve(cmat)) > res <- optim(start, FAfn, > FAgr, > method="L-BFGS-B", > lower = lower, upper = 1, > control = c(list(fnscale=1, > parscale = rep(0.01, length(start))), control), > q = factors, S = cmat) > res > } > > covmat <- > structure(c(1, 0.0920030858518061, 0.053952442382614, -0.0380048634941013, > 0.237986469993129, 0.243144461077282, 0.0920030858518061, 1, > 0.328163804480881, 0.142002180914605, -0.139369611642031, -0.0670944471678571, > 0.053952442382614, 0.328163804480881, 1, 0.267648727315665, -0.0549987508157441, > -0.107488501744669, -0.0380048634941013, 0.142002180914605, 0.267648727315665, > 1, -0.0566976575082817, -0.132943658387513, 0.237986469993129, > -0.139369611642031, -0.0549987508157441, -0.0566976575082817, > 1, 0.352367996102745, 0.243144461077282, -0.0670944471678571, > -0.107488501744669, -0.132943658387513, 0.352367996102745, 1), .Dim = c(6L, > 6L), .Dimnames = list(c("bg2cost1", "bg2cost2", "bg2cost3", "bg2cost4", > "bg2cost5", "bg2cost6"), c("bg2cost1", "bg2cost2", "bg2cost3", > "bg2cost4", "bg2cost5", "bg2cost6"))) > > > > factanal.fit.uls(covmat,2) > $par > bg2cost1 bg2cost2 bg2cost3 bg2cost4 bg2cost5 bg2cost6 > 0.7454829 0.7191459 0.6969019 0.7611750 0.6940870 0.6930580 > > $value > [1] 0.02167674 > > $counts > function gradient > 21 21 > > $convergence > [1] 52 > > $message > [1] "ERROR: ABNORMAL_TERMINATION_IN_LNSRCH" > > -- > Ronggui Huang > Department of Sociology > Fudan University, Shanghai, China > > ______________________________________________ > R-help at stat.math.ethz.ch mailing list > https://stat.ethz.ch/mailman/listinfo/r-help > PLEASE do read the posting guide http://www.R-project.org/posting-guide.html > and provide commented, minimal, self-contained, reproducible code. >
On 5/19/07, ronggui <ronggui.huang at gmail.com> wrote:> I try to code the ULS factor analysis descrbied in > ftp://ftp.spss.com/pub/spss/statistics/spss/algorithms/ factor.pdf > # see PP5-6 > > factanal.fit.uls <- function(cmat, factors, start=NULL, lower = 0.005, > control = NULL, ...) > { > FAfn <- function(Psi, S, q) > { > Sstar <- S - diag(Psi) > E <- eigen(Sstar, symmetric = TRUE, only.values = TRUE) > e <- E$values[-(1:q)] > e <- sum(e^2/2) > e > } > > FAgr <- function(Psi, S, q) > { > Sstar <- S - diag(Psi) > E <- eigen(Sstar, symmetric = TRUE) > L <- E$vectors[, -(1:q), drop = FALSE] > e <- E$values[-(1:q)] > gr <- 2*Psi*((L^2)%*%e) > gr > } > > p <- ncol(cmat) > if(is.null(start)) > start <- (1 - 0.5*factors/p)/diag(solve(cmat)) > res <- optim(start, FAfn, > FAgr, > method="L-BFGS-B", > lower = lower, upper = 1, > control = c(list(fnscale=1, > parscale = rep(0.01, length(start))), control), > q = factors, S = cmat)I forgot to tell that the code to get "start" and " res <- optim(....) " if from stats:::factanal.fit.mle.> res > } > > covmat <- > structure(c(1, 0.0920030858518061, 0.053952442382614, -0.0380048634941013, > 0.237986469993129, 0.243144461077282, 0.0920030858518061, 1, > 0.328163804480881, 0.142002180914605, -0.139369611642031, -0.0670944471678571, > 0.053952442382614, 0.328163804480881, 1, 0.267648727315665, -0.0549987508157441, > -0.107488501744669, -0.0380048634941013, 0.142002180914605, 0.267648727315665, > 1, -0.0566976575082817, -0.132943658387513, 0.237986469993129, > -0.139369611642031, -0.0549987508157441, -0.0566976575082817, > 1, 0.352367996102745, 0.243144461077282, -0.0670944471678571, > -0.107488501744669, -0.132943658387513, 0.352367996102745, 1), .Dim = c(6L, > 6L), .Dimnames = list(c("bg2cost1", "bg2cost2", "bg2cost3", "bg2cost4", > "bg2cost5", "bg2cost6"), c("bg2cost1", "bg2cost2", "bg2cost3", > "bg2cost4", "bg2cost5", "bg2cost6"))) > > > > factanal.fit.uls(covmat,2) > $par > bg2cost1 bg2cost2 bg2cost3 bg2cost4 bg2cost5 bg2cost6 > 0.7454829 0.7191459 0.6969019 0.7611750 0.6940870 0.6930580 > > $value > [1] 0.02167674 > > $counts > function gradient > 21 21 > > $convergence > [1] 52 > > $message > [1] "ERROR: ABNORMAL_TERMINATION_IN_LNSRCH" > > -- > Ronggui Huang > Department of Sociology > Fudan University, Shanghai, China >-- Ronggui Huang Department of Sociology Fudan University, Shanghai, China