これでよいかな
因子間相関係数行列は factanal の返すオブジェクトには含まれない(単に表示されるだけ)
promax2 の digits 引数は,因子間相関係数を表示する小数点以下の桁数
promax2 <- function (x, m = 4, digits = 3)
{
sortLoadings <- function(z, cor)
{
order2 <- order(colSums(z^2), decreasing=TRUE)
z <- z[, order2, drop = FALSE]
cor <- cor[order2, order2]
neg <- colSums(z) < 0
z[, neg] <- -z[, neg]
cor[, neg] <- -cor[, neg]
cor[neg,] <- -cor[neg,]
return(list(z=z, cor=cor))
}
if (ncol(x) <2) return(x)
dn <- dimnames(x)
xx <- varimax(x)
x <- xx$loadings
Q <- x * abs(x)^(m - 1)
U <- lm.fit(x, Q)$coefficients
d <- diag(solve(t(U) %*% U))
U <- U %*% diag(sqrt(d))
z <- x %*% U
U <- xx$rotmat %*% U
cor <- solve(t(U)%*%U)
ans <- sortLoadings(z, cor)
z <- ans$z
cor <- ans$cor
dimnames(z) <- dn
class(z) <- "loadings"
colnames(cor) <- rownames(cor) <- colnames(x)
cat("因子間相関係数行列\n")
print(round(cor, digits))
list(loadings = z)
}
因子間相関係数行列は factanal の返すオブジェクトには含まれない(単に表示されるだけ)
promax2 の digits 引数は,因子間相関係数を表示する小数点以下の桁数
promax2 <- function (x, m = 4, digits = 3)
{
sortLoadings <- function(z, cor)
{
order2 <- order(colSums(z^2), decreasing=TRUE)
z <- z[, order2, drop = FALSE]
cor <- cor[order2, order2]
neg <- colSums(z) < 0
z[, neg] <- -z[, neg]
cor[, neg] <- -cor[, neg]
cor[neg,] <- -cor[neg,]
return(list(z=z, cor=cor))
}
if (ncol(x) <2) return(x)
dn <- dimnames(x)
xx <- varimax(x)
x <- xx$loadings
Q <- x * abs(x)^(m - 1)
U <- lm.fit(x, Q)$coefficients
d <- diag(solve(t(U) %*% U))
U <- U %*% diag(sqrt(d))
z <- x %*% U
U <- xx$rotmat %*% U
cor <- solve(t(U)%*%U)
ans <- sortLoadings(z, cor)
z <- ans$z
cor <- ans$cor
dimnames(z) <- dn
class(z) <- "loadings"
colnames(cor) <- rownames(cor) <- colnames(x)
cat("因子間相関係数行列\n")
print(round(cor, digits))
list(loadings = z)
}
※コメント投稿者のブログIDはブログ作成者のみに通知されます